ENFABAL ;WIRMFO/SAB-MAINTAIN FILE 6915.9 FAP BALANCES ;4/23/96
;;7.0;ENGINEERING;**29**;AUG 17, 1883
;This routine should not be modified.
ADJBAL(STN,FUND,SGL,MTH,NET) ; Adjust Balance Amount in File #6915.9
; called from FAP Documents and Recalculation option
; Input
; STN - station number (3-5 char)
; FUND - fund pointer (to NX FUND)
; SGL - standard general ledger pointer (to NX SGL)
; MTH - month (FileMan date)
; NET - net $ change (can include two decimals)
N BAL,ENFDA,ENI,LMTH,LMTHI,NBAL,PMTH,PMTHI
Q:$G(STN)=""!($G(FUND)="")!($G(SGL)="")!($G(MTH)="")!($G(NET)="")
Q:MTH'?7N ; not FileMan date
Q:NET=0 ; no change
I $E(MTH,6,7)'="00" S MTH=$E(MTH,1,5)_"00"
; add/find entry
S ENFDA(6915.9,"?+1,",.01)=STN
S ENFDA(6915.91,"?+2,?+1,",.01)=FUND
S ENFDA(6915.911,"?+3,?+2,?+1,",.01)=SGL
S ENFDA(6915.9111,"?+4,?+3,?+2,?+1,",.01)=MTH
D UPDATE^DIE("","ENFDA","ENI") D MSG^DIALOG()
;
L +^ENG(6915.9,ENI(1),1,ENI(2),1,ENI(3),1,ENI(4),0):5
; get current balance
S BAL=$$GETBAL(ENI(1),ENI(2),ENI(3),MTH)
; calc/post new balance
S NBAL=BAL+NET
S $P(^ENG(6915.9,ENI(1),1,ENI(2),1,ENI(3),1,ENI(4),0),U,2)=NBAL
L -^ENG(6915.9,ENI(1),1,ENI(2),1,ENI(3),1,ENI(4),0)
; increase balance in later months (if any)
S LMTH=MTH
F S LMTH=$O(^ENG(6915.9,ENI(1),1,ENI(2),1,ENI(3),1,"B",LMTH)) Q:LMTH="" D
. S LMTHI=$O(^ENG(6915.9,ENI(1),1,ENI(2),1,ENI(3),1,"B",LMTH,0))
. L +^ENG(6915.9,ENI(1),1,ENI(2),1,ENI(3),1,LMTHI,0):5
. S BAL=$P(^ENG(6915.9,ENI(1),1,ENI(2),1,ENI(3),1,LMTHI,0),U,2)
. S NBAL=BAL+NET
. S $P(^ENG(6915.9,ENI(1),1,ENI(2),1,ENI(3),1,LMTHI,0),U,2)=NBAL
. L -^ENG(6915.9,ENI(1),1,ENI(2),1,ENI(3),1,LMTHI,0)
Q
;
GETBAL(IEN1,IEN2,IEN3,MTH) ; Get Balance Amount from File #6915.9
; called from ADJBAL and routine ENFAR5*
; Input
; IEN1 - ien of station
; IEN2 - ien of fund multiple
; IEN3 - ien of sgl multiple
; MTH - month (FileMan date)
; Output
; BAL - balance amount
N BAL,IEN4,PMTH,PMTHI
S IEN4=$O(^ENG(6915.9,ENI(1),1,ENI(2),1,ENI(3),1,"B",MTH,0))
S BAL=$S(IEN4:$P($G(^ENG(6915.9,IEN1,1,IEN2,1,IEN3,1,IEN4,0)),U,2),1:"")
I BAL="" D ; perhaps there is a balance in previous month
. S PMTH=$O(^ENG(6915.9,ENI(1),1,ENI(2),1,ENI(3),1,"B",MTH),-1)
. Q:PMTH=""
. S PMTHI=$O(^ENG(6915.9,ENI(1),1,ENI(2),1,ENI(3),1,"B",PMTH,0))
. S BAL=$P(^ENG(6915.9,ENI(1),1,ENI(2),1,ENI(3),1,PMTHI,0),U,2)
Q BAL
;
RECALC ; Recalculate Net Activity for Month (optionally update file 6915.9)
; called from option ENFA RECALC BALANCES
; ask for period (month/year)
S DIR(0)="D^::E^K:($E(Y,4,5)=""00"")!($E(Y,1,5)>$E(DT,1,5)) X"
S DIR("A")="Enter month to recalculate"
S X("Y")=$E(DT,1,3),X("M")=$E(DT,4,5)
S X=$S(X("M")="01":(X("Y")-1)_"12",1:X("Y")_$E("00",1,2-$L(X("M")-1))_(X("M")-1))_"00"
S DIR("B")=$$FMTE^XLFDT(X)
K X
S DIR("?",1)="Month and year are required and future dates are invalid."
S DIR("?")="Enter the month and year to recalculate balances."
D ^DIR K DIR G:$D(DIRUT) EXIT
S ENDTR=$E(Y,1,5)_"00" ; month to recalculate
;
W !!,"You have chosen to recalculate the $ from FAP transactions during"
W !,"the month of ",$$FMTE^XLFDT(ENDTR),"."
I $E(DT,1,5)=$E(ENDTR,1,5) D
. W $C(7),!!,"WARNING - Current month was selected. FAP Document Files will be"
. W !,"locked to ensure that no FAP transactions (FA, FB, FC, FD, and FR)"
. W !,"can be processed during the recalculation."
W ! S DIR(0)="Y",DIR("A")="OK to proceed"
D ^DIR K DIR G:'Y!$D(DIRUT) EXIT
I $E(DT,1,5)=$E(ENDTR,1,5) D I 'ENLOCK W !,$C(7),"Can't Proceed. Try Later" G EXIT
. S ENLOCK=1
. L +^ENG(6915.2):2 I '$T W !,"FA Document Log in use." S ENLOCK=0
. L +^ENG(6915.3):2 I '$T W !,"FB Document Log in use." S ENLOCK=0
. L +^ENG(6915.4):2 I '$T W !,"FC Document Log in use." S ENLOCK=0
. L +^ENG(6915.5):2 I '$T W !,"FD Document Log in use." S ENLOCK=0
. L +^ENG(6915.6):2 I '$T W !,"FR Document Log in use." S ENLOCK=0
;
K ^TMP($J)
; calculating net activity and save in ^TMP($J,"R",
W !!,"Calculating net activity from transactions..." D SUM^ENFABAL1
; compare and save problems in ^TMP($J,"P",
W !,"Comparing FAP BALANCES file with transactions..." D FVST^ENFABAL1
W !,"Comparing transactions with FAP BALANCES file..." D TVSF^ENFABAL2
;
I '$D(^TMP($J,"P")) W !!,"No problems were found." G EXIT
;
W $C(7),!!,"Problems were found..." D ^ENFABAL2 ; report
;
W ! S DIR(0)="Y",DIR("A")="OK to correct file"
D ^DIR K DIR G:'Y!$D(DIRUT) EXIT
;
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 ENFUNDI=$O(^ENG(6914.6,"B",ENFUND,0))
. . S ENSGL=""
. . F S ENSGL=$O(^TMP($J,"P",ENSN,ENFUND,ENSGL)) Q:ENSGL="" D
. . . S ENSGLI=$O(^ENG(6914.3,"B",ENSGL,0))
. . . S Y=$G(^TMP($J,"P",ENSN,ENFUND,ENSGL))
. . . S ENADJ=$P(Y,U,2)-$P(Y,U)
. . . D ADJBAL^ENFABAL(ENSN,ENFUNDI,ENSGLI,ENDTR,ENADJ)
;
EXIT ;
I $E(DT,1,5)=$E($G(ENDTR),1,5) D
. L -^ENG(6915.2):2
. L -^ENG(6915.3):2
. L -^ENG(6915.4):2
. L -^ENG(6915.5):2
. L -^ENG(6915.6):2
K ^TMP($J)
K ENADJ,ENDTR,ENFUND,ENFUNDI,ENLOCK,ENSGL,ENSGLI,ENSN
K DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
Q
;ENFABAL
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENFABAL 5261 printed Oct 16, 2024@17:54:07 Page 2
ENFABAL ;WIRMFO/SAB-MAINTAIN FILE 6915.9 FAP BALANCES ;4/23/96
+1 ;;7.0;ENGINEERING;**29**;AUG 17, 1883
+2 ;This routine should not be modified.
ADJBAL(STN,FUND,SGL,MTH,NET) ; Adjust Balance Amount in File #6915.9
+1 ; called from FAP Documents and Recalculation option
+2 ; Input
+3 ; STN - station number (3-5 char)
+4 ; FUND - fund pointer (to NX FUND)
+5 ; SGL - standard general ledger pointer (to NX SGL)
+6 ; MTH - month (FileMan date)
+7 ; NET - net $ change (can include two decimals)
+8 NEW BAL,ENFDA,ENI,LMTH,LMTHI,NBAL,PMTH,PMTHI
+9 if $GET(STN)=""!($GET(FUND)="")!($GET(SGL)="")!($GET(MTH)="")!($GET(NET)="")
QUIT
+10 ; not FileMan date
if MTH'?7N
QUIT
+11 ; no change
if NET=0
QUIT
+12 IF $EXTRACT(MTH,6,7)'="00"
SET MTH=$EXTRACT(MTH,1,5)_"00"
+13 ; add/find entry
+14 SET ENFDA(6915.9,"?+1,",.01)=STN
+15 SET ENFDA(6915.91,"?+2,?+1,",.01)=FUND
+16 SET ENFDA(6915.911,"?+3,?+2,?+1,",.01)=SGL
+17 SET ENFDA(6915.9111,"?+4,?+3,?+2,?+1,",.01)=MTH
+18 DO UPDATE^DIE("","ENFDA","ENI")
DO MSG^DIALOG()
+19 ;
+20 LOCK +^ENG(6915.9,ENI(1),1,ENI(2),1,ENI(3),1,ENI(4),0):5
+21 ; get current balance
+22 SET BAL=$$GETBAL(ENI(1),ENI(2),ENI(3),MTH)
+23 ; calc/post new balance
+24 SET NBAL=BAL+NET
+25 SET $PIECE(^ENG(6915.9,ENI(1),1,ENI(2),1,ENI(3),1,ENI(4),0),U,2)=NBAL
+26 LOCK -^ENG(6915.9,ENI(1),1,ENI(2),1,ENI(3),1,ENI(4),0)
+27 ; increase balance in later months (if any)
+28 SET LMTH=MTH
+29 FOR
SET LMTH=$ORDER(^ENG(6915.9,ENI(1),1,ENI(2),1,ENI(3),1,"B",LMTH))
if LMTH=""
QUIT
Begin DoDot:1
+30 SET LMTHI=$ORDER(^ENG(6915.9,ENI(1),1,ENI(2),1,ENI(3),1,"B",LMTH,0))
+31 LOCK +^ENG(6915.9,ENI(1),1,ENI(2),1,ENI(3),1,LMTHI,0):5
+32 SET BAL=$PIECE(^ENG(6915.9,ENI(1),1,ENI(2),1,ENI(3),1,LMTHI,0),U,2)
+33 SET NBAL=BAL+NET
+34 SET $PIECE(^ENG(6915.9,ENI(1),1,ENI(2),1,ENI(3),1,LMTHI,0),U,2)=NBAL
+35 LOCK -^ENG(6915.9,ENI(1),1,ENI(2),1,ENI(3),1,LMTHI,0)
End DoDot:1
+36 QUIT
+37 ;
GETBAL(IEN1,IEN2,IEN3,MTH) ; Get Balance Amount from File #6915.9
+1 ; called from ADJBAL and routine ENFAR5*
+2 ; Input
+3 ; IEN1 - ien of station
+4 ; IEN2 - ien of fund multiple
+5 ; IEN3 - ien of sgl multiple
+6 ; MTH - month (FileMan date)
+7 ; Output
+8 ; BAL - balance amount
+9 NEW BAL,IEN4,PMTH,PMTHI
+10 SET IEN4=$ORDER(^ENG(6915.9,ENI(1),1,ENI(2),1,ENI(3),1,"B",MTH,0))
+11 SET BAL=$SELECT(IEN4:$PIECE($GET(^ENG(6915.9,IEN1,1,IEN2,1,IEN3,1,IEN4,0)),U,2),1:"")
+12 ; perhaps there is a balance in previous month
IF BAL=""
Begin DoDot:1
+13 SET PMTH=$ORDER(^ENG(6915.9,ENI(1),1,ENI(2),1,ENI(3),1,"B",MTH),-1)
+14 if PMTH=""
QUIT
+15 SET PMTHI=$ORDER(^ENG(6915.9,ENI(1),1,ENI(2),1,ENI(3),1,"B",PMTH,0))
+16 SET BAL=$PIECE(^ENG(6915.9,ENI(1),1,ENI(2),1,ENI(3),1,PMTHI,0),U,2)
End DoDot:1
+17 QUIT BAL
+18 ;
RECALC ; Recalculate Net Activity for Month (optionally update file 6915.9)
+1 ; called from option ENFA RECALC BALANCES
+2 ; ask for period (month/year)
+3 SET DIR(0)="D^::E^K:($E(Y,4,5)=""00"")!($E(Y,1,5)>$E(DT,1,5)) X"
+4 SET DIR("A")="Enter month to recalculate"
+5 SET X("Y")=$EXTRACT(DT,1,3)
SET X("M")=$EXTRACT(DT,4,5)
+6 SET X=$SELECT(X("M")="01":(X("Y")-1)_"12",1:X("Y")_$EXTRACT("00",1,2-$LENGTH(X("M")-1))_(X("M")-1))_"00"
+7 SET DIR("B")=$$FMTE^XLFDT(X)
+8 KILL X
+9 SET DIR("?",1)="Month and year are required and future dates are invalid."
+10 SET DIR("?")="Enter the month and year to recalculate balances."
+11 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EXIT
+12 ; month to recalculate
SET ENDTR=$EXTRACT(Y,1,5)_"00"
+13 ;
+14 WRITE !!,"You have chosen to recalculate the $ from FAP transactions during"
+15 WRITE !,"the month of ",$$FMTE^XLFDT(ENDTR),"."
+16 IF $EXTRACT(DT,1,5)=$EXTRACT(ENDTR,1,5)
Begin DoDot:1
+17 WRITE $CHAR(7),!!,"WARNING - Current month was selected. FAP Document Files will be"
+18 WRITE !,"locked to ensure that no FAP transactions (FA, FB, FC, FD, and FR)"
+19 WRITE !,"can be processed during the recalculation."
End DoDot:1
+20 WRITE !
SET DIR(0)="Y"
SET DIR("A")="OK to proceed"
+21 DO ^DIR
KILL DIR
if 'Y!$DATA(DIRUT)
GOTO EXIT
+22 IF $EXTRACT(DT,1,5)=$EXTRACT(ENDTR,1,5)
Begin DoDot:1
+23 SET ENLOCK=1
+24 LOCK +^ENG(6915.2):2
IF '$TEST
WRITE !,"FA Document Log in use."
SET ENLOCK=0
+25 LOCK +^ENG(6915.3):2
IF '$TEST
WRITE !,"FB Document Log in use."
SET ENLOCK=0
+26 LOCK +^ENG(6915.4):2
IF '$TEST
WRITE !,"FC Document Log in use."
SET ENLOCK=0
+27 LOCK +^ENG(6915.5):2
IF '$TEST
WRITE !,"FD Document Log in use."
SET ENLOCK=0
+28 LOCK +^ENG(6915.6):2
IF '$TEST
WRITE !,"FR Document Log in use."
SET ENLOCK=0
End DoDot:1
IF 'ENLOCK
WRITE !,$CHAR(7),"Can't Proceed. Try Later"
GOTO EXIT
+29 ;
+30 KILL ^TMP($JOB)
+31 ; calculating net activity and save in ^TMP($J,"R",
+32 WRITE !!,"Calculating net activity from transactions..."
DO SUM^ENFABAL1
+33 ; compare and save problems in ^TMP($J,"P",
+34 WRITE !,"Comparing FAP BALANCES file with transactions..."
DO FVST^ENFABAL1
+35 WRITE !,"Comparing transactions with FAP BALANCES file..."
DO TVSF^ENFABAL2
+36 ;
+37 IF '$DATA(^TMP($JOB,"P"))
WRITE !!,"No problems were found."
GOTO EXIT
+38 ;
+39 ; report
WRITE $CHAR(7),!!,"Problems were found..."
DO ^ENFABAL2
+40 ;
+41 WRITE !
SET DIR(0)="Y"
SET DIR("A")="OK to correct file"
+42 DO ^DIR
KILL DIR
if 'Y!$DATA(DIRUT)
GOTO EXIT
+43 ;
+44 SET ENSN=""
FOR
SET ENSN=$ORDER(^TMP($JOB,"P",ENSN))
if ENSN=""
QUIT
Begin DoDot:1
+45 SET ENFUND=""
FOR
SET ENFUND=$ORDER(^TMP($JOB,"P",ENSN,ENFUND))
if ENFUND=""
QUIT
Begin DoDot:2
+46 SET ENFUNDI=$ORDER(^ENG(6914.6,"B",ENFUND,0))
+47 SET ENSGL=""
+48 FOR
SET ENSGL=$ORDER(^TMP($JOB,"P",ENSN,ENFUND,ENSGL))
if ENSGL=""
QUIT
Begin DoDot:3
+49 SET ENSGLI=$ORDER(^ENG(6914.3,"B",ENSGL,0))
+50 SET Y=$GET(^TMP($JOB,"P",ENSN,ENFUND,ENSGL))
+51 SET ENADJ=$PIECE(Y,U,2)-$PIECE(Y,U)
+52 DO ADJBAL^ENFABAL(ENSN,ENFUNDI,ENSGLI,ENDTR,ENADJ)
End DoDot:3
End DoDot:2
End DoDot:1
+53 ;
EXIT ;
+1 IF $EXTRACT(DT,1,5)=$EXTRACT($GET(ENDTR),1,5)
Begin DoDot:1
+2 LOCK -^ENG(6915.2):2
+3 LOCK -^ENG(6915.3):2
+4 LOCK -^ENG(6915.4):2
+5 LOCK -^ENG(6915.5):2
+6 LOCK -^ENG(6915.6):2
End DoDot:1
+7 KILL ^TMP($JOB)
+8 KILL ENADJ,ENDTR,ENFUND,ENFUNDI,ENLOCK,ENSGL,ENSGLI,ENSN
+9 KILL DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
+10 QUIT
+11 ;ENFABAL
