ENFARC.m

ENFARC ;WIRMFO/SAB-FIXED ASSET RPT, TRANSACTION REGISTER; 6/30/97

 ;;7.0;ENGINEERING;**39**;Aug 17, 1993

EN ; Report FAP Documents (FA, FB, FC, FD, and FR) during Selected Period

 ;

ASKDATE ; ask start date

 S DIR(0)="D^::EX",DIR("A")="Start Date"

 S ENX("Y")=$E(DT,1,3),ENX("M")=$E(DT,4,5)

 S ENX=$S(ENX("M")="01":(ENX("Y")-1)_"12",1:ENX("Y")_$E("00",1,2-$L(ENX("M")-1))_(ENX("M")-1))_"01"

 S DIR("B")=$$FMTE^XLFDT(ENX,"2D")

 D ^DIR K DIR,ENX G:$D(DIRUT) EXIT

 S ENDTS=Y

 ; 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 ASKDATE

 S ENDTE=Y

 ; ask about adjustment vouchers

 S DIR(0)="Y",DIR("A")="Include Adjustment Voucher data",DIR("B")="YES"

 S DIR("?",1)="Answer YES if you want adjustment voucher reason codes"

 S DIR("?",2)="and comments (if any) to print with the FAP Documents."

 S DIR("?",3)=" "

 S DIR("?")="Enter 'Y' or 'N'"

 D ^DIR K DIR G:$D(DIRUT) EXIT

 S ENAV=Y

 ; ask device

 S %ZIS="QM" D ^%ZIS G:POP EXIT

 I $D(IO("Q")) D  G EXIT

 . S ZTRTN="QEN^ENFARC1",ZTDESC="Transaction Register Report"

 . F X="ENDTS","ENDTE","ENAV" S ZTSAVE(X)=""

 . D ^%ZTLOAD,HOME^%ZIS K ZTSK

 D QEN^ENFARC1

EXIT ;

 K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y

 K ENAV,ENDTE,ENDTS

 Q

 ;ENFARC

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ENFARC   1378     printed  Dec 13, 2024@01:53:45                                                                                                                                                                                                      Page 2

ENFARC    ;WIRMFO/SAB-FIXED ASSET RPT, TRANSACTION REGISTER; 6/30/97

 +1       ;;7.0;ENGINEERING;**39**;Aug 17, 1993

EN        ; Report FAP Documents (FA, FB, FC, FD, and FR) during Selected Period

 +1       ;

ASKDATE   ; ask start date

 +1        SET DIR(0)="D^::EX"

           SET DIR("A")="Start Date"

 +2        SET ENX("Y")=$EXTRACT(DT,1,3)

           SET ENX("M")=$EXTRACT(DT,4,5)

 +3        SET ENX=$SELECT(ENX("M")="01":(ENX("Y")-1)_"12",1:ENX("Y")_$EXTRACT("00",1,2-$LENGTH(ENX("M")-1))_(ENX("M")-1))_"01"

 +4        SET DIR("B")=$$FMTE^XLFDT(ENX,"2D")

 +5        DO ^DIR

           KILL DIR,ENX

           if $DATA(DIRUT)

               GOTO EXIT

 +6        SET ENDTS=Y

 +7       ; ask end date

 +8        SET DIR(0)="D^::EX"

           SET DIR("A")="End Date"

 +9        SET ENDTE=$$EOM^ENUTL(ENDTS)

 +10       SET DIR("B")=$$FMTE^XLFDT(ENDTE,"2D")

 +11       DO ^DIR

           KILL DIR

           if $DATA(DIRUT)

               GOTO EXIT

 +12       IF Y<ENDTS

               WRITE $CHAR(7),!,"End date must be after start date!",!

               GOTO ASKDATE

 +13       SET ENDTE=Y

 +14      ; ask about adjustment vouchers

 +15       SET DIR(0)="Y"

           SET DIR("A")="Include Adjustment Voucher data"

           SET DIR("B")="YES"

 +16       SET DIR("?",1)="Answer YES if you want adjustment voucher reason codes"

 +17       SET DIR("?",2)="and comments (if any) to print with the FAP Documents."

 +18       SET DIR("?",3)=" "

 +19       SET DIR("?")="Enter 'Y' or 'N'"

 +20       DO ^DIR

           KILL DIR

           if $DATA(DIRUT)

               GOTO EXIT

 +21       SET ENAV=Y

 +22      ; ask device

 +23       SET %ZIS="QM"

           DO ^%ZIS

           if POP

               GOTO EXIT

 +24       IF $DATA(IO("Q"))

               Begin DoDot:1

 +25               SET ZTRTN="QEN^ENFARC1"

                   SET ZTDESC="Transaction Register Report"

 +26               FOR X="ENDTS","ENDTE","ENAV"

                       SET ZTSAVE(X)=""

 +27               DO ^%ZTLOAD

                   DO HOME^%ZIS

                   KILL ZTSK

               End DoDot:1

               GOTO EXIT

 +28       DO QEN^ENFARC1

EXIT      ;

 +1        KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y

 +2        KILL ENAV,ENDTE,ENDTS

 +3        QUIT 

 +4       ;ENFARC