source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENFAR7.m@ 891

Last change on this file since 891 was 613, checked in by George Lilly, 16 years ago

initial load of WorldVistAEHR
File size: 3.2 KB
Line 
1ENFAR7 ;WIRMFO/SAB-FIXED ASSET RPT, FA DOCUMENTS FOR EXCESS EQUIP; 1.12.98
2 ;;7.0;ENGINEERING;**29,33,46,48**;Aug 17, 1993
3 ; FA Documents for Excess Equipment (SGL 1524) during Accounting Period
4EN ;
5 ; compute default start date (day of previous month)
6 S ENDT("Y")=$E(DT,1,3),ENDT("M")=$E(DT,4,5),ENDT("D")=$E(DT,6,7)
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")
8 I ENDTS>$$EOM^ENUTL(ENDTS) S ENDTS=$$EOM^ENUTL(ENDTS)
9 ; ask start date when interactive
10 I '$D(ZTQUEUED) D G:$D(DIRUT) EXIT
11 . S DIR(0)="D^::EX",DIR("A")="Start Date"
12 . S DIR("B")=$$FMTE^XLFDT(ENDTS,"2D")
13 . D ^DIR K DIR S ENDTS=Y
14ASKDTE ; compute default end date (Today)
15 S ENDTE=$P(DT,".")
16 ; ask end date when interactive
17 I '$D(ZTQUEUED) D G:$D(DIRUT) EXIT
18 . S DIR(0)="D^::EX",DIR("A")="End Date"
19 . S DIR("B")=$$FMTE^XLFDT(ENDTE,"2D")
20 . D ^DIR K DIR S ENDTE=Y
21 I ENDTE<ENDTS W $C(7),!,"End date must be after start date!",! G ASKDTE
22 ; ask device when interactive
23 I '$D(ZTQUEUED) S %ZIS="QM" D ^%ZIS G:POP EXIT I $D(IO("Q")) D G EXIT
24 . S ZTRTN="QEN^ENFAR7",ZTDESC="FA Documents for Excess Equipment"
25 . F X="ENDTS","ENDTE" S ZTSAVE(X)=""
26 . D ^%ZTLOAD,HOME^%ZIS K ZTSK
27QEN ; queued entry
28 U IO
29 K ^TMP($J)
30 ; get/sort FA Documents for excess within date range
31 ; loop thru FA DOCUMENT LOG by created date/time
32 S ENDT=ENDTS
33 F S ENDT=$O(^ENG(6915.2,"D",ENDT)) Q:ENDT=""!($P(ENDT,".")>ENDTE) D
34 . S ENDA=0 F S ENDA=$O(^ENG(6915.2,"D",ENDT,ENDA)) Q:'ENDA D
35 . . S ENY3=$G(^ENG(6915.2,ENDA,3))
36 . . Q:$P(ENY3,U,6)'="X" ; FA TYPE not X (SGL 1524 excess)
37 . . S ENSN=$TR($E($P(ENY3,U,5),1,5)," ","") ; station
38 . . S ENFUND=$P(ENY3,U,10) ; fund
39 . . S ^TMP($J,ENSN,ENFUND,ENDA)=""
40 ; print output
41 S (END,ENPG)=0 D NOW^%DTC S Y=% D DD^%DT S ENDTR=Y
42 S ENL="",$P(ENL,"-",IOM)=""
43 D HD
44 I '$D(^TMP($J)) W !!,"No FA Documents for SGL 1524 in selected period",!
45 S ENSN="" F S ENSN=$O(^TMP($J,ENSN)) Q:ENSN="" D Q:END
46 . W !
47 . S ENFUND="" F S ENFUND=$O(^TMP($J,ENSN,ENFUND)) Q:ENFUND="" D Q:END
48 . . S ENDA=0 F S ENDA=$O(^TMP($J,ENSN,ENFUND,ENDA)) Q:'ENDA D Q:END
49 . . . S ENY0=$G(^ENG(6915.2,ENDA,0))
50 . . . S ENY1=$G(^ENG(6915.2,ENDA,1))
51 . . . S ENY3=$G(^ENG(6915.2,ENDA,3))
52 . . . I $Y+4>IOSL D HD Q:END
53 . . . W !,?3,ENSN,?11,ENFUND,?18,$P(ENY1,U,6)
54 . . . W ?23,$P(ENY1,U,9),?35,$$FMTE^XLFDT($P(ENY0,U,2),"2D")
55 . . . W ?45,$P(ENY0,U),?57,$J($FN($P(ENY3,U,27),",",2),14)
56 I END W !!,"REPORT STOPPED AT USER REQUEST"
57 E I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR
58 D ^%ZISC
59EXIT I $D(ZTQUEUED) S ZTREQ="@"
60 K ^TMP($J)
61 K DIR,DIROUT,DIRUT,DIWF,DIWL,DTOUT,DUOUT,X,Y
62 K END,ENDA,ENDT,ENDTE,ENDTR,ENDTS,ENFUND,ENL,ENPG,ENSN,ENY0,ENY1,ENY3
63 Q
64HD ; page header
65 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1,END=1 Q
66 I $E(IOST,1,2)="C-",ENPG S DIR(0)="E" D ^DIR K DIR I 'Y S END=1 Q
67 I $E(IOST,1,2)="C-"!ENPG W @IOF
68 S ENPG=ENPG+1
69 W !,"FA DOCUMENTS FOR EXCESS EQUIP. (SGL 1524)"
70 W ?49,ENDTR,?72,"page ",ENPG
71 W !," ACCOUNTING PERIOD FROM ",$$FMTE^XLFDT(ENDTS,"2D")
72 W " TO ",$$FMTE^XLFDT(ENDTE,"2D")
73 W !!,?3,"STATION",?11,"FUND",?18,"TRANSACTION"
74 W ?45,"EQUIPMENT",?57,"ASSET VALUE"
75 W !,?18,"CODE NUMBER DATE",?45,"ENTRY #"
76 W !,?3,"-------",?11,"------",?18,"---- ----------- --------"
77 W ?45,"----------",?57,"--------------"
78 Q
Note: See TracBrowser for help on using the repository browser.