ENFARA.m

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 ---ENFARA   1741     printed  Mar 13, 2025@20:58:22                                                                                                                                                                                                      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