- 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 Mar 13, 2025@20:58:19 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
