- ENFABAL2 ;WIRMFO/SAB-MAINTAIN FILE 6915.9 FAP BALANCES (cont) ;7/19/96
- ;;7.0;ENGINEERING;**29,33**;AUG 17, 1883
- ;This routine should not be modified.
- EN ; called from RECALC^ENFABAL
- W !,"Report of FAP Recalculation for "_$$FMTE^XLFDT(ENDTR)
- ; ask device
- S %ZIS="QM" D ^%ZIS G:POP EXIT
- I $D(IO("Q")) D G EXIT
- . S ZTRTN="QEN^ENFABAL2"
- . S ZTDESC="Report of FAP Recalc for "_$$FMTE^XLFDT(ENDTR)
- . F X="ENDTR","^TMP($J,""P""," S ZTSAVE(X)=""
- . D ^%ZTLOAD,HOME^%ZIS K ZTSK
- QEN ; queued entry
- N END,ENDT,ENFUND,ENL,ENPG,ENSGL,ENSN
- U IO
- ; generate output
- S (END,ENPG)=0 D NOW^%DTC S Y=% D DD^%DT S ENDT=Y
- S ENL="",$P(ENL,"-",IOM)=""
- D HD
- S ENSN="" F S ENSN=$O(^TMP($J,"P",ENSN)) Q:ENSN="" D
- . S ENFUND="" F S ENFUND=$O(^TMP($J,"P",ENSN,ENFUND)) Q:ENFUND="" D
- . . S ENSGL=""
- . . F S ENSGL=$O(^TMP($J,"P",ENSN,ENFUND,ENSGL)) Q:ENSGL="" D
- . . . S Y=$G(^TMP($J,"P",ENSN,ENFUND,ENSGL))
- . . . I $Y+5>IOSL D HD
- . . . W !,?2,ENSN,?11,ENFUND,?19,ENSGL,?23,$J($P(Y,U),13,2)
- . . . W ?42,$J($P(Y,U,2),13,2)
- I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR
- D ^%ZISC
- I $D(ZTQUEUED) S ZTREQ="@" K ^TMP($J)
- EXIT K DIR,DIROUT,DIRUT,DIWF,DIWL,DTOUT,DUOUT,X,Y
- Q
- HD ; header
- I $E(IOST,1,2)="C-",ENPG S DIR(0)="E" D ^DIR K DIR I 'Y S END=1 Q
- I $E(IOST,1,2)="C-"!ENPG W @IOF
- S ENPG=ENPG+1
- W !,"FAP Net Activity Comparison",?48,ENDT,?72,"page ",ENPG
- W !!,"FAP Balance File vs. Recalculation for ",$$FMTE^XLFDT(ENDTR)
- W !!,?2,"STATION",?11,"FUND",?19,"SGL",?25,"NET FROM FILE"
- W ?42,"NET FROM RECALCULATION"
- Q
- ;
- TVSF ; compare transactions vs. file
- ; called from RECALC^ENFABAL
- ; input
- ; ENDTR - month to recalculate (FileMan date)
- ; ^TMP($J,"R",station,fund,sgl)=net $ activity from recalc
- ; output -
- ; problems where net activity is not equal in
- ; ^TMP($J,"P",station,fund,sgl)=net from file^net from recalc
- N ENI,ENFUND,ENFUNDI,ENPM,ENPMI,ENSGL,ENSGLI,ENSMI,ENSN,PAMT,RAMT,SAMT
- ; loop thru station
- S ENSN="" F S ENSN=$O(^TMP($J,"R",ENSN)) Q:ENSN="" D
- . S ENI(1)=$O(^ENG(6915.9,"B",ENSN,0))
- . ; loop thru fund
- . S ENFUND="" F S ENFUND=$O(^TMP($J,"R",ENSN,ENFUND)) Q:ENFUND="" D
- . . S ENFUNDI=$O(^ENG(6914.6,"B",ENFUND,0))
- . . S ENI(2)=$S(ENI(1):$O(^ENG(6915.9,ENI(1),1,"B",ENFUNDI,0)),1:"")
- . . ; loop thru sgl
- . . S ENSGL=""
- . . F S ENSGL=$O(^TMP($J,"R",ENSN,ENFUND,ENSGL)) Q:ENSGL="" D
- . . . S ENSGLI=$O(^ENG(6914.3,"B",ENSGL,0))
- . . . S ENI(3)=$S(ENI(2):$O(^ENG(6915.9,ENI(1),1,ENI(2),1,"B",ENSGLI,0)),1:"")
- . . . I ENI(1),ENI(2),ENI(3) Q ; already checked in FVST module
- . . . S ENSMI=$S(ENI(3):$O(^ENG(6915.9,ENI(1),1,ENI(2),1,ENI(3),1,"B",ENDTR,0)),1:"")
- . . . S ENPM=$S(ENI(3):$O(^ENG(6915.9,ENI(1),1,ENI(2),1,ENI(3),1,"B",ENDTR),-1),1:"")
- . . . S ENPMI=$S(ENPM:$O(^ENG(6915.9,ENI(1),1,ENI(2),1,ENI(3),1,"B",ENPM,0)),1:"")
- . . . S SAMT=$S(ENSMI:$P($G(^ENG(6915.9,ENI(1),1,ENI(2),1,ENI(3),1,ENSMI,0)),U,2),1:"")
- . . . S PAMT=$S(ENPMI:$P($G(^ENG(6915.9,ENI(1),1,ENI(2),1,ENI(3),1,ENPMI,0)),U,2),1:"")
- . . . I SAMT="" S SAMT=PAMT ; balance inherited from prior month
- . . . S RAMT=$P($G(^TMP($J,"R",ENSN,ENFUND,ENSGL)),U)
- . . . I +(SAMT-PAMT)'=+RAMT S ^TMP($J,"P",ENSN,ENFUND,ENSGL)=(+(SAMT-PAMT))_U_(+RAMT)
- Q
- ;ENFABAL2
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENFABAL2 3257 printed Apr 23, 2025@18:07:49 Page 2
- ENFABAL2 ;WIRMFO/SAB-MAINTAIN FILE 6915.9 FAP BALANCES (cont) ;7/19/96
- +1 ;;7.0;ENGINEERING;**29,33**;AUG 17, 1883
- +2 ;This routine should not be modified.
- EN ; called from RECALC^ENFABAL
- +1 WRITE !,"Report of FAP Recalculation for "_$$FMTE^XLFDT(ENDTR)
- +2 ; ask device
- +3 SET %ZIS="QM"
- DO ^%ZIS
- if POP
- GOTO EXIT
- +4 IF $DATA(IO("Q"))
- Begin DoDot:1
- +5 SET ZTRTN="QEN^ENFABAL2"
- +6 SET ZTDESC="Report of FAP Recalc for "_$$FMTE^XLFDT(ENDTR)
- +7 FOR X="ENDTR","^TMP($J,""P"","
- SET ZTSAVE(X)=""
- +8 DO ^%ZTLOAD
- DO HOME^%ZIS
- KILL ZTSK
- End DoDot:1
- GOTO EXIT
- QEN ; queued entry
- +1 NEW END,ENDT,ENFUND,ENL,ENPG,ENSGL,ENSN
- +2 USE IO
- +3 ; generate output
- +4 SET (END,ENPG)=0
- DO NOW^%DTC
- SET Y=%
- DO DD^%DT
- SET ENDT=Y
- +5 SET ENL=""
- SET $PIECE(ENL,"-",IOM)=""
- +6 DO HD
- +7 SET ENSN=""
- FOR
- SET ENSN=$ORDER(^TMP($JOB,"P",ENSN))
- if ENSN=""
- QUIT
- Begin DoDot:1
- +8 SET ENFUND=""
- FOR
- SET ENFUND=$ORDER(^TMP($JOB,"P",ENSN,ENFUND))
- if ENFUND=""
- QUIT
- Begin DoDot:2
- +9 SET ENSGL=""
- +10 FOR
- SET ENSGL=$ORDER(^TMP($JOB,"P",ENSN,ENFUND,ENSGL))
- if ENSGL=""
- QUIT
- Begin DoDot:3
- +11 SET Y=$GET(^TMP($JOB,"P",ENSN,ENFUND,ENSGL))
- +12 IF $Y+5>IOSL
- DO HD
- +13 WRITE !,?2,ENSN,?11,ENFUND,?19,ENSGL,?23,$JUSTIFY($PIECE(Y,U),13,2)
- +14 WRITE ?42,$JUSTIFY($PIECE(Y,U,2),13,2)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +15 IF $EXTRACT(IOST,1,2)="C-"
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- +16 DO ^%ZISC
- +17 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- KILL ^TMP($JOB)
- EXIT KILL DIR,DIROUT,DIRUT,DIWF,DIWL,DTOUT,DUOUT,X,Y
- +1 QUIT
- HD ; header
- +1 IF $EXTRACT(IOST,1,2)="C-"
- IF ENPG
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF 'Y
- SET END=1
- QUIT
- +2 IF $EXTRACT(IOST,1,2)="C-"!ENPG
- WRITE @IOF
- +3 SET ENPG=ENPG+1
- +4 WRITE !,"FAP Net Activity Comparison",?48,ENDT,?72,"page ",ENPG
- +5 WRITE !!,"FAP Balance File vs. Recalculation for ",$$FMTE^XLFDT(ENDTR)
- +6 WRITE !!,?2,"STATION",?11,"FUND",?19,"SGL",?25,"NET FROM FILE"
- +7 WRITE ?42,"NET FROM RECALCULATION"
- +8 QUIT
- +9 ;
- TVSF ; compare transactions vs. file
- +1 ; called from RECALC^ENFABAL
- +2 ; input
- +3 ; ENDTR - month to recalculate (FileMan date)
- +4 ; ^TMP($J,"R",station,fund,sgl)=net $ activity from recalc
- +5 ; output -
- +6 ; problems where net activity is not equal in
- +7 ; ^TMP($J,"P",station,fund,sgl)=net from file^net from recalc
- +8 NEW ENI,ENFUND,ENFUNDI,ENPM,ENPMI,ENSGL,ENSGLI,ENSMI,ENSN,PAMT,RAMT,SAMT
- +9 ; loop thru station
- +10 SET ENSN=""
- FOR
- SET ENSN=$ORDER(^TMP($JOB,"R",ENSN))
- if ENSN=""
- QUIT
- Begin DoDot:1
- +11 SET ENI(1)=$ORDER(^ENG(6915.9,"B",ENSN,0))
- +12 ; loop thru fund
- +13 SET ENFUND=""
- FOR
- SET ENFUND=$ORDER(^TMP($JOB,"R",ENSN,ENFUND))
- if ENFUND=""
- QUIT
- Begin DoDot:2
- +14 SET ENFUNDI=$ORDER(^ENG(6914.6,"B",ENFUND,0))
- +15 SET ENI(2)=$SELECT(ENI(1):$ORDER(^ENG(6915.9,ENI(1),1,"B",ENFUNDI,0)),1:"")
- +16 ; loop thru sgl
- +17 SET ENSGL=""
- +18 FOR
- SET ENSGL=$ORDER(^TMP($JOB,"R",ENSN,ENFUND,ENSGL))
- if ENSGL=""
- QUIT
- Begin DoDot:3
- +19 SET ENSGLI=$ORDER(^ENG(6914.3,"B",ENSGL,0))
- +20 SET ENI(3)=$SELECT(ENI(2):$ORDER(^ENG(6915.9,ENI(1),1,ENI(2),1,"B",ENSGLI,0)),1:"")
- +21 ; already checked in FVST module
- IF ENI(1)
- IF ENI(2)
- IF ENI(3)
- QUIT
- +22 SET ENSMI=$SELECT(ENI(3):$ORDER(^ENG(6915.9,ENI(1),1,ENI(2),1,ENI(3),1,"B",ENDTR,0)),1:"")
- +23 SET ENPM=$SELECT(ENI(3):$ORDER(^ENG(6915.9,ENI(1),1,ENI(2),1,ENI(3),1,"B",ENDTR),-1),1:"")
- +24 SET ENPMI=$SELECT(ENPM:$ORDER(^ENG(6915.9,ENI(1),1,ENI(2),1,ENI(3),1,"B",ENPM,0)),1:"")
- +25 SET SAMT=$SELECT(ENSMI:$PIECE($GET(^ENG(6915.9,ENI(1),1,ENI(2),1,ENI(3),1,ENSMI,0)),U,2),1:"")
- +26 SET PAMT=$SELECT(ENPMI:$PIECE($GET(^ENG(6915.9,ENI(1),1,ENI(2),1,ENI(3),1,ENPMI,0)),U,2),1:"")
- +27 ; balance inherited from prior month
- IF SAMT=""
- SET SAMT=PAMT
- +28 SET RAMT=$PIECE($GET(^TMP($JOB,"R",ENSN,ENFUND,ENSGL)),U)
- +29 IF +(SAMT-PAMT)'=+RAMT
- SET ^TMP($JOB,"P",ENSN,ENFUND,ENSGL)=(+(SAMT-PAMT))_U_(+RAMT)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +30 QUIT
- +31 ;ENFABAL2
