ENFAR5 ;WIRMFO/SAB-FIXED ASSET RPT, VOUCHER SUMMARY; 4/7/97
;;7.0;ENGINEERING;**29,39**;Aug 17, 1993
; Voucher Summary of FAP Documents for Station during Accounting Period
EN ;
; ask STATION
S DIR(0)="F^3:5",DIR("A")="STATION NUMBER"
S DIR("B")=$$GET1^DIQ(6910,"1,",1)
D ^DIR K DIR G:$D(DIRUT) EXIT
S ENSNR=Y
; ask start date
S DIR(0)="D^::EX",DIR("A")="Start Date"
S ENDT("Y")=$E(DT,1,3),ENDT("M")=$E(DT,4,5)
S ENDTS=$S(ENDT("M")="01":(ENDT("Y")-1)_"12",1:ENDT("Y")_$E("00",1,2-$L(ENDT("M")-1))_(ENDT("M")-1))_"01"
S DIR("B")=$$FMTE^XLFDT(ENDTS,"2D")
D ^DIR K DIR G:$D(DIRUT) EXIT
S ENDTS=Y
ASKDTE ; ask end date
S DIR(0)="D^::EX",DIR("A")="End Date"
S ENDTE=$$EOM^ENUTL(ENDTS)
S DIR("B")=$$FMTE^XLFDT(ENDTE,"2D")
D ^DIR K DIR G:$D(DIRUT) EXIT
I Y<ENDTS W $C(7),!,"End date must be after start date!",! G ASKDTE
S ENDTE=Y
; ask device
S %ZIS="QM" D ^%ZIS G:POP EXIT
I $D(IO("Q")) D G EXIT
. S ZTRTN="QEN^ENFAR5",ZTDESC="Voucher Summary for Station"
. F X="ENSNR","ENDTS","ENDTE" S ZTSAVE(X)=""
. D ^%ZTLOAD,HOME^%ZIS K ZTSK
QEN ; queued entry
U IO
; determine 2 months for which balances should be reported
S ENDT("Y")=$E(ENDTS,1,3),ENDT("M")=$E(ENDTS,4,5)
S ENDTM1=$S(ENDT("M")="01":(ENDT("Y")-1)_"12",1:ENDT("Y")_$E("00",1,2-$L(ENDT("M")-1))_(ENDT("M")-1))_"00"
S ENDTM2=$E(ENDTE,1,5)_"00"
;
D GETDATA^ENFAR5A
D GETBAL^ENFAR5B
D PRINT^ENFAR5B
D ^%ZISC
EXIT I $D(ZTQUEUED) S ZTREQ="@"
K DIR,DIROUT,DIRUT,DIWF,DIWL,DTOUT,DUOUT,X,Y
K ^TMP($J),ENAMT,ENBAL,ENBAL1,ENBAL2,END,ENDA,ENDT,ENDTE
K ENDTM1,ENDTM2,ENDTR,ENDTS,ENFAY3,ENFILE,ENFUND,ENFUNDNW
K ENI,ENIEN,ENL,ENPG,ENNOTE,ENSGL,ENSNR,ENT,ENY,ENY0,ENY1
Q
;ENFAR5
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENFAR5 1706 printed Nov 22, 2024@17:03:44 Page 2
ENFAR5 ;WIRMFO/SAB-FIXED ASSET RPT, VOUCHER SUMMARY; 4/7/97
+1 ;;7.0;ENGINEERING;**29,39**;Aug 17, 1993
+2 ; Voucher Summary of FAP Documents for Station during Accounting Period
EN ;
+1 ; ask STATION
+2 SET DIR(0)="F^3:5"
SET DIR("A")="STATION NUMBER"
+3 SET DIR("B")=$$GET1^DIQ(6910,"1,",1)
+4 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EXIT
+5 SET ENSNR=Y
+6 ; ask start date
+7 SET DIR(0)="D^::EX"
SET DIR("A")="Start Date"
+8 SET ENDT("Y")=$EXTRACT(DT,1,3)
SET ENDT("M")=$EXTRACT(DT,4,5)
+9 SET ENDTS=$SELECT(ENDT("M")="01":(ENDT("Y")-1)_"12",1:ENDT("Y")_$EXTRACT("00",1,2-$LENGTH(ENDT("M")-1))_(ENDT("M")-1))_"01"
+10 SET DIR("B")=$$FMTE^XLFDT(ENDTS,"2D")
+11 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EXIT
+12 SET ENDTS=Y
ASKDTE ; ask end date
+1 SET DIR(0)="D^::EX"
SET DIR("A")="End Date"
+2 SET ENDTE=$$EOM^ENUTL(ENDTS)
+3 SET DIR("B")=$$FMTE^XLFDT(ENDTE,"2D")
+4 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EXIT
+5 IF Y<ENDTS
WRITE $CHAR(7),!,"End date must be after start date!",!
GOTO ASKDTE
+6 SET ENDTE=Y
+7 ; ask device
+8 SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO EXIT
+9 IF $DATA(IO("Q"))
Begin DoDot:1
+10 SET ZTRTN="QEN^ENFAR5"
SET ZTDESC="Voucher Summary for Station"
+11 FOR X="ENSNR","ENDTS","ENDTE"
SET ZTSAVE(X)=""
+12 DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK
End DoDot:1
GOTO EXIT
QEN ; queued entry
+1 USE IO
+2 ; determine 2 months for which balances should be reported
+3 SET ENDT("Y")=$EXTRACT(ENDTS,1,3)
SET ENDT("M")=$EXTRACT(ENDTS,4,5)
+4 SET ENDTM1=$SELECT(ENDT("M")="01":(ENDT("Y")-1)_"12",1:ENDT("Y")_$EXTRACT("00",1,2-$LENGTH(ENDT("M")-1))_(ENDT("M")-1))_"00"
+5 SET ENDTM2=$EXTRACT(ENDTE,1,5)_"00"
+6 ;
+7 DO GETDATA^ENFAR5A
+8 DO GETBAL^ENFAR5B
+9 DO PRINT^ENFAR5B
+10 DO ^%ZISC
EXIT IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+1 KILL DIR,DIROUT,DIRUT,DIWF,DIWL,DTOUT,DUOUT,X,Y
+2 KILL ^TMP($JOB),ENAMT,ENBAL,ENBAL1,ENBAL2,END,ENDA,ENDT,ENDTE
+3 KILL ENDTM1,ENDTM2,ENDTR,ENDTS,ENFAY3,ENFILE,ENFUND,ENFUNDNW
+4 KILL ENI,ENIEN,ENL,ENPG,ENNOTE,ENSGL,ENSNR,ENT,ENY,ENY0,ENY1
+5 QUIT
+6 ;ENFAR5