qr86_26.txt

* PROGRAM: QR86_26.PRG

* Look at cap movement by day for FY26

* Visual Foxpro version close all create table qr86_26a FREE (flag c(1), accept c(10), appgrp c(4), mpc c(4), dept c(3), actnum c(8), level n(1,0),;

ytd_lvl1 n(14,2), ytd_lvl2 n(14,2), ytd_lvl3 n(14,2), ytd_lvl4 n(14,2),;

level1 n(14,2), level2 n(14,2), level3 n(14,2), level4 n(14,2)) index on accept+appgrp+mpc+dept+actnum to x1 create table qr86_26b FREE (flag c(1), no_budget c(1), appgrp c(4), mpc c(4), dept c(3), actnum c(8), level n(1,0),;

level1 n(14,2), level2 n(14,2), level3 n(14,2), level4 n(14,2), encumber n(14,2), expended n(14,2), unexpended n(14,2)) index on appgrp+mpc+dept+actnum to x2 select e use x86_26 SCAN for lineamt<>0 if type('accept')='D' XX1=dtoc(accept,1) XACCEPT=left(XX1,4)+'-'+substr(XX1,5,2)+'-'+substr(XX1,7,2) else XACCEPT=left(accept,10) endif

XDATE=XACCEPT

XAMT=lineamt*iif(incdec=2,-1,1) XMD=left(mdnum,3) XACT=left(actnum,8) XLEVEL=level0 if .t.

select a if not seek(XDATE+e.app_grp+e.mpc+XMD+XACT) append blank replace accept with XDATE, appgrp with e.app_grp, mpc with e.mpc, dept with XMD, actnum with XACT endif replace level4 with level4+iif(XLEVEL=4,XAMT,0) if not seek(XDATE+e.app_grp+e.mpc+XMD+space(8)) append blank replace accept with XDATE, appgrp with e.app_grp, mpc with e.mpc, dept with XMD endif replace level3 with level3+iif(XLEVEL=3,XAMT,0), level4 with level4+iif(XLEVEL=4,XAMT,0) if not seek(XDATE+e.app_grp+e.mpc+space(11)) append blank replace accept with XDATE, appgrp with e.app_grp, mpc with e.mpc endif replace level2 with level2+iif(XLEVEL=2,XAMT,0), level3 with level3+iif(XLEVEL=3,XAMT,0),;

level4 with level4+iif(XLEVEL=4,XAMT,0) if not seek(XDATE+e.app_grp+space(15)) append blank replace accept with XDATE, appgrp with e.app_grp endif replace level1 with level1+iif(XLEVEL=1,XAMT,0), level2 with level2+iif(XLEVEL=2,XAMT,0),;

level3 with level3+iif(XLEVEL=3,XAMT,0), level4 with level4+iif(XLEVEL=4,XAMT,0) select e endif if .t.

select b if not seek(e.app_grp+e.mpc+XMD+XACT) append blank replace appgrp with e.app_grp, mpc with e.mpc, dept with XMD, actnum with XACT endif replace level4 with level4+iif(XLEVEL=4,XAMT,0) if not seek(e.app_grp+e.mpc+XMD+space(8)) append blank replace appgrp with e.app_grp, mpc with e.mpc, dept with XMD endif replace level3 with level3+iif(XLEVEL=3,XAMT,0), level4 with level4+iif(XLEVEL=4,XAMT,0) if not seek(e.app_grp+e.mpc+space(11)) append blank replace appgrp with e.app_grp, mpc with e.mpc endif replace level2 with level2+iif(XLEVEL=2,XAMT,0), level3 with level3+iif(XLEVEL=3,XAMT,0),;

level4 with level4+iif(XLEVEL=4,XAMT,0) if not seek(e.app_grp+space(15)) append blank replace appgrp with e.app_grp endif replace level1 with level1+iif(XLEVEL=1,XAMT,0), level2 with level2+iif(XLEVEL=2,XAMT,0),;

level3 with level3+iif(XLEVEL=3,XAMT,0), level4 with level4+iif(XLEVEL=4,XAMT,0) select e endif

ENDSCAN

select a replace level with 1 for not empty(appgrp) replace level with 2 for not empty(mpc) replace level with 3 for not empty(dept) replace level with 4 for not empty(actnum)

SCAN

XACT=actnum XMD=dept XMPC=mpc XGRP=appgrp XDATE=accept XLVL1=level1 XLVL2=level2 XLVL3=level3 XLVL4=level4 xx=recno() replace ytd_lvl1 with ytd_lvl1+XLVL1, ytd_lvl2 with ytd_lvl2+XLVL2, ytd_lvl3 with ytd_lvl3+XLVL3,;

ytd_lvl4 with ytd_lvl4+XLVL4 for actnum=XACT and dept=XMD and mpc=XMPC and appgrp=XGRP and accept>=XDATE goto xx

ENDSCAN

replace flag with 'X' for level=1 and ytd_lvl1<>ytd_lvl2 replace flag with 'X' for level=2 and (ytd_lvl2<>ytd_lvl3 and ytd_lvl3<>0) copy to k:\dbf\qr86_26a TYPE fox2x IF .t.

FILE1='qr86_26a' DO p:\vfox\MAKE_CSV endif select b replace level with 1 for not empty(appgrp) replace level with 2 for not empty(mpc) replace level with 3 for not empty(dept) replace level with 4 for not empty(actnum) replace flag with 'X' for level=1 and level1<>level2 replace flag with 'X' for level=2 and (level2<>level3 and level3<>0) select c use qrcap1

SCAN

select b

XLEVEL=1

locate for level=1 and appgrp=c.apprgrp if not found() append blank replace level with 1, appgrp with c.apprgrp, no_budget with 'X' endif

XLEVEL=2

locate for level=2 and appgrp=c.apprgrp and mpc=c.mpc if not found() append blank replace level with 2, appgrp with c.apprgrp, mpc with c.mpc, no_budget with 'X' endif

XLEVEL=3

locate for level=3 and appgrp=c.apprgrp and mpc=c.mpc and dept=c.mdnum if not found() append blank replace level with 3, appgrp with c.apprgrp, mpc with c.mpc, dept with c.mdnum, no_budget with 'X' endif select c

ENDSCAN

select b replace unexpended with level1-expended for level=1 replace unexpended with level2-expended for level=2 replace unexpended with level3-expended for level=3 replace unexpended with level4-expended for level=4 copy to k:\dbf\qr86_26b TYPE fox2x