- ECTFBAL ;B'ham ISC/PTD-Fund Control Point Balance Sheet ;01/29/91 08:00
- V ;;1.05;INTERIM MANAGEMENT SUPPORT;;
- I '$D(^PRC(420)) W *7,!!?29,"OPTION IS UNAVAILABLE!",!,"The 'Fund Control Point' File - #420 is not loaded on your system.",!! S XQUIT="" Q
- I '$O(^PRC(420,0)) W *7,!!,"'Fund Control Point' File - #420 has not been populated on your system.",!! S XQUIT="" Q
- S CNT=0 F J=0:0 S J=$O(^PRC(420,J)) Q:'J S CNT=CNT+1
- DIC I CNT>1 W !! S DIC="^PRC(420,",DIC(0)="QEANM",DIC("A")="Select STATION number: " D ^DIC G:Y<0 EXIT S STNUM=+Y
- I CNT=1 S STNUM=$O(^PRC(420,0))
- YR W !,"You may select the fiscal year for this report.",!
- S %DT="AE",%DT("A")="Enter FISCAL YEAR: ",%DT(0)=2850000 D ^%DT K %DT G:$D(DTOUT)!("^"[X) EXIT S YRDA=$E(Y,1,3),YR=$E(Y,2,3)
- QTR S CYR=$E(DT,1,3),CFY=$E(DT,4)+CYR,QTR=$E(222333444111,+$E(DT,4,5)) I YRDA<CFY S QTR=4
- I YRDA>CFY W *7,!!?10,"FUTURE fiscal years NOT allowed.",! K YRDA,YR,CYR,CFY,CMO G YR
- DIP S DIC="^PRC(420,",BY="@.01,1;S,.01,1,15,@.01",(FR,TO)=STNUM_",,"_YR,L=0
- I QTR=1 S FLDS="1,.01,.5,15,1;L10;C35;""1QTR UNCOM BAL"",5;L10;C50;""1QTR UNOBL BAL"",9;L10;C65;""1QTR SCP UNCOM BAL"""
- I QTR=2 S FLDS="1,.01,.5,15,2;L10;C35;""2QTR UNCOM BAL"",6;L10;C50;""2QTR UNOBL BAL"",10;L10;C65;""2QTR SCP UNCOM BAL"""
- I QTR=3 S FLDS="1,.01,.5,15,3;L10;C35;""3QTR UNCOM BAL"",7;L10;C50;""3QTR UNOBL BAL"",11;L10;C65;""3QTR SCP UNCOM BAL"""
- I QTR=4 S FLDS="1,.01,.5,15,4;L10;C35;""4QTR UNCOM BAL"",8;L10;C50;""4QTR UNOBL BAL"",12;L10;C65;""4QTR SCP UNCOM BAL"""
- S DHD="FUND CONTROL POINT REPORT FOR FY '"_YR D EN1^DIP
- EXIT K %,%DT,%Y,B,BY,CFY,CNT,CYR,DHD,DIC,DTOUT,FLDS,FR,J,L,QTR,STNUM,TO,X,Y,YR,YRDA
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECTFBAL 1663 printed Feb 18, 2025@23:28:43 Page 2
- ECTFBAL ;B'ham ISC/PTD-Fund Control Point Balance Sheet ;01/29/91 08:00
- V ;;1.05;INTERIM MANAGEMENT SUPPORT;;
- +1 IF '$DATA(^PRC(420))
- WRITE *7,!!?29,"OPTION IS UNAVAILABLE!",!,"The 'Fund Control Point' File - #420 is not loaded on your system.",!!
- SET XQUIT=""
- QUIT
- +2 IF '$ORDER(^PRC(420,0))
- WRITE *7,!!,"'Fund Control Point' File - #420 has not been populated on your system.",!!
- SET XQUIT=""
- QUIT
- +3 SET CNT=0
- FOR J=0:0
- SET J=$ORDER(^PRC(420,J))
- if 'J
- QUIT
- SET CNT=CNT+1
- DIC IF CNT>1
- WRITE !!
- SET DIC="^PRC(420,"
- SET DIC(0)="QEANM"
- SET DIC("A")="Select STATION number: "
- DO ^DIC
- if Y<0
- GOTO EXIT
- SET STNUM=+Y
- +1 IF CNT=1
- SET STNUM=$ORDER(^PRC(420,0))
- YR WRITE !,"You may select the fiscal year for this report.",!
- +1 SET %DT="AE"
- SET %DT("A")="Enter FISCAL YEAR: "
- SET %DT(0)=2850000
- DO ^%DT
- KILL %DT
- if $DATA(DTOUT)!("^"[X)
- GOTO EXIT
- SET YRDA=$EXTRACT(Y,1,3)
- SET YR=$EXTRACT(Y,2,3)
- QTR SET CYR=$EXTRACT(DT,1,3)
- SET CFY=$EXTRACT(DT,4)+CYR
- SET QTR=$EXTRACT(222333444111,+$EXTRACT(DT,4,5))
- IF YRDA<CFY
- SET QTR=4
- +1 IF YRDA>CFY
- WRITE *7,!!?10,"FUTURE fiscal years NOT allowed.",!
- KILL YRDA,YR,CYR,CFY,CMO
- GOTO YR
- DIP SET DIC="^PRC(420,"
- SET BY="@.01,1;S,.01,1,15,@.01"
- SET (FR,TO)=STNUM_",,"_YR
- SET L=0
- +1 IF QTR=1
- SET FLDS="1,.01,.5,15,1;L10;C35;""1QTR UNCOM BAL"",5;L10;C50;""1QTR UNOBL BAL"",9;L10;C65;""1QTR SCP UNCOM BAL"""
- +2 IF QTR=2
- SET FLDS="1,.01,.5,15,2;L10;C35;""2QTR UNCOM BAL"",6;L10;C50;""2QTR UNOBL BAL"",10;L10;C65;""2QTR SCP UNCOM BAL"""
- +3 IF QTR=3
- SET FLDS="1,.01,.5,15,3;L10;C35;""3QTR UNCOM BAL"",7;L10;C50;""3QTR UNOBL BAL"",11;L10;C65;""3QTR SCP UNCOM BAL"""
- +4 IF QTR=4
- SET FLDS="1,.01,.5,15,4;L10;C35;""4QTR UNCOM BAL"",8;L10;C50;""4QTR UNOBL BAL"",12;L10;C65;""4QTR SCP UNCOM BAL"""
- +5 SET DHD="FUND CONTROL POINT REPORT FOR FY '"_YR
- DO EN1^DIP
- EXIT KILL %,%DT,%Y,B,BY,CFY,CNT,CYR,DHD,DIC,DTOUT,FLDS,FR,J,L,QTR,STNUM,TO,X,Y,YR,YRDA
- +1 QUIT
- +2 ;
