ENFARA ;WIRMFO/SAB-FIXED ASSET RPT, ADJUSTMENT VOUCHER ;6/30/97
;;7.0;ENGINEERING;**39**;Aug 17, 1993
; Adjustment Vouchers during Selected Period
; This report can be scheduled for automatic queuing.
EN ;
; set start date to yesterday
S ENDTS=$$FMADD^XLFDT($P(DT,"."),"-1")
; ask start date when interactive
I '$D(ZTQUEUED) D G:$D(DIRUT) EXIT
. S DIR(0)="D^::EX",DIR("A")="Start Date",DIR("B")="T-1"
. D ^DIR K DIR S ENDTS=Y
; set end date equal to start date
S ENDTE=ENDTS
; ask end date when interactive
I '$D(ZTQUEUED) D G:$D(DIRUT) EXIT
. S DIR(0)="D^::EX",DIR("A")="End Date",DIR("B")=$$FMTE^XLFDT(ENDTS,"D")
. D ^DIR K DIR S ENDTE=Y
I ENDTE<ENDTS W $C(7),!,"End date can't be prior to start date!",! G EN
; set sort by user to NO
S ENSRT("U")=0
; ask sort by user when interactive
I '$D(ZTQUEUED) D G:$D(DIRUT) EXIT
. S DIR(0)="Y",DIR("B")="NO"
. S DIR("A")="Sort by person that created the Adj. Voucher"
. D ^DIR K DIR S ENSRT("U")=Y
I '$D(ZTQUEUED),ENSRT("U") D G:ENSRT("U",0)="" EXIT
. S ENSRT("U",0)=""
. S DIR(0)="Y"
. S DIR("A")="Include all users",DIR("B")="YES"
. D ^DIR K DIR Q:$G(DIRUT)
. I Y S ENSRT("U",0)="*",ENSRT("U",0,"E")="ALL USERS"
. E D
. . S DIC="^VA(200,",DIC(0)="AQEM"
. . S DIC("B")=$$GET1^DIQ(200,DUZ,.01)
. . D ^DIC K DIC Q:Y<1
. . S ENSRT("U",0)=+Y,ENSRT("U",0,"E")=$$GET1^DIQ(200,+Y,.01)
; ask device when interactive
I '$D(ZTQUEUED) S %ZIS="QM" D ^%ZIS G:POP EXIT I $D(IO("Q")) D G EXIT
. S ZTRTN="QEN^ENFARA1",ZTDESC="Adjustment Voucher Report"
. F X="ENDTS","ENDTE","ENSRT(" S ZTSAVE(X)=""
. D ^%ZTLOAD,HOME^%ZIS K ZTSK
D QEN^ENFARA1
EXIT ;
K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
K ENDTE,ENDTS,ENSRT
Q
;ENFARA
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENFARA 1741 printed Dec 13, 2024@01:53:42 Page 2
ENFARA ;WIRMFO/SAB-FIXED ASSET RPT, ADJUSTMENT VOUCHER ;6/30/97
+1 ;;7.0;ENGINEERING;**39**;Aug 17, 1993
+2 ; Adjustment Vouchers during Selected Period
+3 ; This report can be scheduled for automatic queuing.
EN ;
+1 ; set start date to yesterday
+2 SET ENDTS=$$FMADD^XLFDT($PIECE(DT,"."),"-1")
+3 ; ask start date when interactive
+4 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+5 SET DIR(0)="D^::EX"
SET DIR("A")="Start Date"
SET DIR("B")="T-1"
+6 DO ^DIR
KILL DIR
SET ENDTS=Y
End DoDot:1
if $DATA(DIRUT)
GOTO EXIT
+7 ; set end date equal to start date
+8 SET ENDTE=ENDTS
+9 ; ask end date when interactive
+10 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+11 SET DIR(0)="D^::EX"
SET DIR("A")="End Date"
SET DIR("B")=$$FMTE^XLFDT(ENDTS,"D")
+12 DO ^DIR
KILL DIR
SET ENDTE=Y
End DoDot:1
if $DATA(DIRUT)
GOTO EXIT
+13 IF ENDTE<ENDTS
WRITE $CHAR(7),!,"End date can't be prior to start date!",!
GOTO EN
+14 ; set sort by user to NO
+15 SET ENSRT("U")=0
+16 ; ask sort by user when interactive
+17 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+18 SET DIR(0)="Y"
SET DIR("B")="NO"
+19 SET DIR("A")="Sort by person that created the Adj. Voucher"
+20 DO ^DIR
KILL DIR
SET ENSRT("U")=Y
End DoDot:1
if $DATA(DIRUT)
GOTO EXIT
+21 IF '$DATA(ZTQUEUED)
IF ENSRT("U")
Begin DoDot:1
+22 SET ENSRT("U",0)=""
+23 SET DIR(0)="Y"
+24 SET DIR("A")="Include all users"
SET DIR("B")="YES"
+25 DO ^DIR
KILL DIR
if $GET(DIRUT)
QUIT
+26 IF Y
SET ENSRT("U",0)="*"
SET ENSRT("U",0,"E")="ALL USERS"
+27 IF '$TEST
Begin DoDot:2
+28 SET DIC="^VA(200,"
SET DIC(0)="AQEM"
+29 SET DIC("B")=$$GET1^DIQ(200,DUZ,.01)
+30 DO ^DIC
KILL DIC
if Y<1
QUIT
+31 SET ENSRT("U",0)=+Y
SET ENSRT("U",0,"E")=$$GET1^DIQ(200,+Y,.01)
End DoDot:2
End DoDot:1
if ENSRT("U",0)=""
GOTO EXIT
+32 ; ask device when interactive
+33 IF '$DATA(ZTQUEUED)
SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO EXIT
IF $DATA(IO("Q"))
Begin DoDot:1
+34 SET ZTRTN="QEN^ENFARA1"
SET ZTDESC="Adjustment Voucher Report"
+35 FOR X="ENDTS","ENDTE","ENSRT("
SET ZTSAVE(X)=""
+36 DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK
End DoDot:1
GOTO EXIT
+37 DO QEN^ENFARA1
EXIT ;
+1 KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 KILL ENDTE,ENDTS,ENSRT
+3 QUIT
+4 ;ENFARA
