ENFAR7 ;WIRMFO/SAB-FIXED ASSET RPT, FA DOCUMENTS FOR EXCESS EQUIP; 1.12.98 ; 4/15/13 11:51am
;;7.0;ENGINEERING;**29,33,46,48,92**;Aug 17, 1993;Build 10
; FA Documents for Excess Equipment (SGL 1995) during Accounting Period
;patch 92 renamed sgl 1524 to 1995
EN ;
; compute default start date (day of previous month)
S ENDT("Y")=$E(DT,1,3),ENDT("M")=$E(DT,4,5),ENDT("D")=$E(DT,6,7)
S ENDTS=$S(ENDT("M")="01":(ENDT("Y")-1)_"12",1:ENDT("Y")_$E("00",1,2-$L(ENDT("M")-1))_(ENDT("M")-1))_ENDT("D")
I ENDTS>$$EOM^ENUTL(ENDTS) S ENDTS=$$EOM^ENUTL(ENDTS)
; ask start date when interactive
I '$D(ZTQUEUED) D G:$D(DIRUT) EXIT
. S DIR(0)="D^::EX",DIR("A")="Start Date"
. S DIR("B")=$$FMTE^XLFDT(ENDTS,"2D")
. D ^DIR K DIR S ENDTS=Y
ASKDTE ; compute default end date (Today)
S ENDTE=$P(DT,".")
; ask end date when interactive
I '$D(ZTQUEUED) D G:$D(DIRUT) EXIT
. S DIR(0)="D^::EX",DIR("A")="End Date"
. S DIR("B")=$$FMTE^XLFDT(ENDTE,"2D")
. D ^DIR K DIR S ENDTE=Y
I ENDTE<ENDTS W $C(7),!,"End date must be after start date!",! G ASKDTE
; 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^ENFAR7",ZTDESC="FA Documents for Excess Equipment"
. F X="ENDTS","ENDTE" S ZTSAVE(X)=""
. D ^%ZTLOAD,HOME^%ZIS K ZTSK
QEN ; queued entry
U IO
K ^TMP($J)
; get/sort FA Documents for excess within date range
; loop thru FA DOCUMENT LOG by created date/time
S ENDT=ENDTS
F S ENDT=$O(^ENG(6915.2,"D",ENDT)) Q:ENDT=""!($P(ENDT,".")>ENDTE) D
. S ENDA=0 F S ENDA=$O(^ENG(6915.2,"D",ENDT,ENDA)) Q:'ENDA D
. . S ENY3=$G(^ENG(6915.2,ENDA,3))
. . Q:$P(ENY3,U,6)'="X" ; FA TYPE not X (SGL 1995 excess)
. . S ENSN=$TR($E($P(ENY3,U,5),1,5)," ","") ; station
. . S ENFUND=$P(ENY3,U,10) ; fund
. . S ^TMP($J,ENSN,ENFUND,ENDA)=""
; print output
S (END,ENPG)=0 D NOW^%DTC S Y=% D DD^%DT S ENDTR=Y
S ENL="",$P(ENL,"-",IOM)=""
D HD
I '$D(^TMP($J)) W !!,"No FA Documents for SGL 1995 in selected period",!
S ENSN="" F S ENSN=$O(^TMP($J,ENSN)) Q:ENSN="" D Q:END
. W !
. S ENFUND="" F S ENFUND=$O(^TMP($J,ENSN,ENFUND)) Q:ENFUND="" D Q:END
. . S ENDA=0 F S ENDA=$O(^TMP($J,ENSN,ENFUND,ENDA)) Q:'ENDA D Q:END
. . . S ENY0=$G(^ENG(6915.2,ENDA,0))
. . . S ENY1=$G(^ENG(6915.2,ENDA,1))
. . . S ENY3=$G(^ENG(6915.2,ENDA,3))
. . . I $Y+4>IOSL D HD Q:END
. . . W !,?3,ENSN,?11,ENFUND,?18,$P(ENY1,U,6)
. . . W ?23,$P(ENY1,U,9),?35,$$FMTE^XLFDT($P(ENY0,U,2),"2D")
. . . W ?45,$P(ENY0,U),?57,$J($FN($P(ENY3,U,27),",",2),14)
I END W !!,"REPORT STOPPED AT USER REQUEST"
E I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR
D ^%ZISC
EXIT I $D(ZTQUEUED) S ZTREQ="@"
K ^TMP($J)
K DIR,DIROUT,DIRUT,DIWF,DIWL,DTOUT,DUOUT,X,Y
K END,ENDA,ENDT,ENDTE,ENDTR,ENDTS,ENFUND,ENL,ENPG,ENSN,ENY0,ENY1,ENY3
Q
HD ; page header
I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1,END=1 Q
I $E(IOST,1,2)="C-",ENPG S DIR(0)="E" D ^DIR K DIR I 'Y S END=1 Q
I $E(IOST,1,2)="C-"!ENPG W @IOF
S ENPG=ENPG+1
W !,"FA DOCUMENTS FOR EXCESS EQUIP. (SGL 1995)"
W ?49,ENDTR,?72,"page ",ENPG
W !," ACCOUNTING PERIOD FROM ",$$FMTE^XLFDT(ENDTS,"2D")
W " TO ",$$FMTE^XLFDT(ENDTE,"2D")
W !!,?3,"STATION",?11,"FUND",?18,"TRANSACTION"
W ?45,"EQUIPMENT",?57,"ASSET VALUE"
W !,?18,"CODE NUMBER DATE",?45,"ENTRY #"
W !,?3,"-------",?11,"------",?18,"---- ----------- --------"
W ?45,"----------",?57,"--------------"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENFAR7 3436 printed Apr 09, 2024@21:00:43 Page 2
ENFAR7 ;WIRMFO/SAB-FIXED ASSET RPT, FA DOCUMENTS FOR EXCESS EQUIP; 1.12.98 ; 4/15/13 11:51am
+1 ;;7.0;ENGINEERING;**29,33,46,48,92**;Aug 17, 1993;Build 10
+2 ; FA Documents for Excess Equipment (SGL 1995) during Accounting Period
+3 ;patch 92 renamed sgl 1524 to 1995
EN ;
+1 ; compute default start date (day of previous month)
+2 SET ENDT("Y")=$EXTRACT(DT,1,3)
SET ENDT("M")=$EXTRACT(DT,4,5)
SET ENDT("D")=$EXTRACT(DT,6,7)
+3 SET ENDTS=$SELECT(ENDT("M")="01":(ENDT("Y")-1)_"12",1:ENDT("Y")_$EXTRACT("00",1,2-$LENGTH(ENDT("M")-1))_(ENDT("M")-1))_ENDT("D")
+4 IF ENDTS>$$EOM^ENUTL(ENDTS)
SET ENDTS=$$EOM^ENUTL(ENDTS)
+5 ; ask start date when interactive
+6 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+7 SET DIR(0)="D^::EX"
SET DIR("A")="Start Date"
+8 SET DIR("B")=$$FMTE^XLFDT(ENDTS,"2D")
+9 DO ^DIR
KILL DIR
SET ENDTS=Y
End DoDot:1
if $DATA(DIRUT)
GOTO EXIT
ASKDTE ; compute default end date (Today)
+1 SET ENDTE=$PIECE(DT,".")
+2 ; ask end date when interactive
+3 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+4 SET DIR(0)="D^::EX"
SET DIR("A")="End Date"
+5 SET DIR("B")=$$FMTE^XLFDT(ENDTE,"2D")
+6 DO ^DIR
KILL DIR
SET ENDTE=Y
End DoDot:1
if $DATA(DIRUT)
GOTO EXIT
+7 IF ENDTE<ENDTS
WRITE $CHAR(7),!,"End date must be after start date!",!
GOTO ASKDTE
+8 ; ask device when interactive
+9 IF '$DATA(ZTQUEUED)
SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO EXIT
IF $DATA(IO("Q"))
Begin DoDot:1
+10 SET ZTRTN="QEN^ENFAR7"
SET ZTDESC="FA Documents for Excess Equipment"
+11 FOR X="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 KILL ^TMP($JOB)
+3 ; get/sort FA Documents for excess within date range
+4 ; loop thru FA DOCUMENT LOG by created date/time
+5 SET ENDT=ENDTS
+6 FOR
SET ENDT=$ORDER(^ENG(6915.2,"D",ENDT))
if ENDT=""!($PIECE(ENDT,".")>ENDTE)
QUIT
Begin DoDot:1
+7 SET ENDA=0
FOR
SET ENDA=$ORDER(^ENG(6915.2,"D",ENDT,ENDA))
if 'ENDA
QUIT
Begin DoDot:2
+8 SET ENY3=$GET(^ENG(6915.2,ENDA,3))
+9 ; FA TYPE not X (SGL 1995 excess)
if $PIECE(ENY3,U,6)'="X"
QUIT
+10 ; station
SET ENSN=$TRANSLATE($EXTRACT($PIECE(ENY3,U,5),1,5)," ","")
+11 ; fund
SET ENFUND=$PIECE(ENY3,U,10)
+12 SET ^TMP($JOB,ENSN,ENFUND,ENDA)=""
End DoDot:2
End DoDot:1
+13 ; print output
+14 SET (END,ENPG)=0
DO NOW^%DTC
SET Y=%
DO DD^%DT
SET ENDTR=Y
+15 SET ENL=""
SET $PIECE(ENL,"-",IOM)=""
+16 DO HD
+17 IF '$DATA(^TMP($JOB))
WRITE !!,"No FA Documents for SGL 1995 in selected period",!
+18 SET ENSN=""
FOR
SET ENSN=$ORDER(^TMP($JOB,ENSN))
if ENSN=""
QUIT
Begin DoDot:1
+19 WRITE !
+20 SET ENFUND=""
FOR
SET ENFUND=$ORDER(^TMP($JOB,ENSN,ENFUND))
if ENFUND=""
QUIT
Begin DoDot:2
+21 SET ENDA=0
FOR
SET ENDA=$ORDER(^TMP($JOB,ENSN,ENFUND,ENDA))
if 'ENDA
QUIT
Begin DoDot:3
+22 SET ENY0=$GET(^ENG(6915.2,ENDA,0))
+23 SET ENY1=$GET(^ENG(6915.2,ENDA,1))
+24 SET ENY3=$GET(^ENG(6915.2,ENDA,3))
+25 IF $Y+4>IOSL
DO HD
if END
QUIT
+26 WRITE !,?3,ENSN,?11,ENFUND,?18,$PIECE(ENY1,U,6)
+27 WRITE ?23,$PIECE(ENY1,U,9),?35,$$FMTE^XLFDT($PIECE(ENY0,U,2),"2D")
+28 WRITE ?45,$PIECE(ENY0,U),?57,$JUSTIFY($FNUMBER($PIECE(ENY3,U,27),",",2),14)
End DoDot:3
if END
QUIT
End DoDot:2
if END
QUIT
End DoDot:1
if END
QUIT
+29 IF END
WRITE !!,"REPORT STOPPED AT USER REQUEST"
+30 IF '$TEST
IF $EXTRACT(IOST,1,2)="C-"
SET DIR(0)="E"
DO ^DIR
KILL DIR
+31 DO ^%ZISC
EXIT IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+1 KILL ^TMP($JOB)
+2 KILL DIR,DIROUT,DIRUT,DIWF,DIWL,DTOUT,DUOUT,X,Y
+3 KILL END,ENDA,ENDT,ENDTE,ENDTR,ENDTS,ENFUND,ENL,ENPG,ENSN,ENY0,ENY1,ENY3
+4 QUIT
HD ; page header
+1 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET ZTSTOP=1
SET END=1
QUIT
+2 IF $EXTRACT(IOST,1,2)="C-"
IF ENPG
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET END=1
QUIT
+3 IF $EXTRACT(IOST,1,2)="C-"!ENPG
WRITE @IOF
+4 SET ENPG=ENPG+1
+5 WRITE !,"FA DOCUMENTS FOR EXCESS EQUIP. (SGL 1995)"
+6 WRITE ?49,ENDTR,?72,"page ",ENPG
+7 WRITE !," ACCOUNTING PERIOD FROM ",$$FMTE^XLFDT(ENDTS,"2D")
+8 WRITE " TO ",$$FMTE^XLFDT(ENDTE,"2D")
+9 WRITE !!,?3,"STATION",?11,"FUND",?18,"TRANSACTION"
+10 WRITE ?45,"EQUIPMENT",?57,"ASSET VALUE"
+11 WRITE !,?18,"CODE NUMBER DATE",?45,"ENTRY #"
+12 WRITE !,?3,"-------",?11,"------",?18,"---- ----------- --------"
+13 WRITE ?45,"----------",?57,"--------------"
+14 QUIT
