source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENFAR8.m@ 738

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

initial load of WorldVistAEHR

File size: 5.7 KB
RevLine 
[613]1ENFAR8 ;WIRMFO/SAB-FIXED ASSET RPT, EQUIP LOCATOR LIST FOR STATION ;1/18/2001
2 ;;7.0;ENGINEERING;**29,33,50,63,69**;Aug 17, 1993
3 ; Equipment Locator List for STATION
4 ;
5EN ;
6 ; ask STATION
7 S DIR(0)="F^3:5",DIR("A")="STATION NUMBER"
8 S DIR("B")=$$GET1^DIQ(6910,"1,",1)
9 D ^DIR K DIR G:$D(DIRUT) EXIT
10 S ENSNR=Y
11 ; ask about including not capitalized/accountable equipment
12 S DIR(0)="Y"
13 S DIR("A")="Include Not Capitalized/Accountable Equipment"
14 S DIR("B")="YES"
15 S DIR("?",1)="This report lists capitalized equipment on a CMR."
16 S DIR("?",2)=" "
17 S DIR("?",3)="Equipment with an Investment Category of NOT CAPITALIZED/ACCOUNTABLE"
18 S DIR("?",4)="can also be included in the output."
19 S DIR("?",6)=" "
20 S DIR("?")="Enter YES to list all accountable equipment."
21 D ^DIR K DIR G:$D(DIRUT) EXIT
22 S ENEXP=Y
23 ; ask device
24 S %ZIS="QM" D ^%ZIS G:POP EXIT
25 I $D(IO("Q")) D G EXIT
26 . S ZTRTN="QEN^ENFAR8",ZTDESC="Equipment List for Station"
27 . S ZTSAVE("ENSNR")="",ZTSAVE("ENEXP")=""
28 . D ^%ZTLOAD,HOME^%ZIS K ZTSK
29QEN ; queued entry
30 U IO
31 ; collect and sort equipment
32 K ^TMP($J)
33 S ENSND=$$GET1^DIQ(6910,"1,",1) ; default station number
34 S ENDA=0 F S ENDA=$O(^ENG(6914,ENDA)) Q:'ENDA D
35 . S ENSN=$P($G(^ENG(6914,ENDA,9)),U,5) S:ENSN="" ENSN=ENSND
36 . Q:ENSN'=ENSNR ; not station
37 . S ENY2=$G(^ENG(6914,ENDA,2))
38 . S X=$P(ENY2,U,9),ENCMR=$S(X:$E($P($G(^ENG(6914.1,X,0)),U),1,5),1:"")
39 . Q:ENCMR="" ; not on a CMR
40 . S ENCSNI=$P(ENY2,U,8)
41 . S ENCSN=$S(ENCSNI:$P($G(^ENCSN(6917,ENCSNI,0)),U),1:"")
42 . I ENCSN="" S (ENCSN,ENCSNI)="<null value>"
43 . S ENY8=$G(^ENG(6914,ENDA,8))
44 . ; quit when not capitalized (or not accountable if user specified)
45 . Q:$S(ENEXP:"^1^A^",1:"^1^")'[(U_$P(ENY8,U,2)_U)
46 . ;Q:'($P(ENY8,U,2)) ;*63
47 . ;Q:'($P(ENY8,U,2))&'(ENEXP&("^10^23^70^"[(U_$E(ENCSN,1,2)_U))) ;*50
48 . S ^TMP($J,ENCSN,ENCMR,ENDA)=""
49 . I $D(^TMP($J,ENCSN))#10=0 S ^TMP($J,ENCSN)=ENCSNI
50 ; generate output
51 K ENT
52 S (END,ENPG)=0 D NOW^%DTC S Y=% D DD^%DT S ENDT=Y
53 S ENL="",$P(ENL,"-",IOM)=""
54 S ENCSN="" D HD
55 I 'END F S ENCSN=$O(^TMP($J,ENCSN)) Q:ENCSN="" D Q:END
56 . ; category stock number
57 . S ENC="0^0" ; initialize CSN count and value
58 . S ENCSNI=$P($G(^TMP($J,ENCSN)),U)
59 . I $Y+4>IOSL D HD Q:END
60 . W !! W:ENCSNI $P($G(^ENCSN(6917,ENCSNI,0)),U,3) W " (CSN: ",ENCSN,")"
61 . S ENCMR="" F S ENCMR=$O(^TMP($J,ENCSN,ENCMR)) Q:ENCMR="" D Q:END
62 . . ; cmr
63 . . S ENDA=0 F S ENDA=$O(^TMP($J,ENCSN,ENCMR,ENDA)) Q:'ENDA D Q:END
64 . . . ; equipment item
65 . . . S ENY2=$G(^ENG(6914,ENDA,2))
66 . . . S X=$P($G(^ENG(6914,ENDA,8)),U,6)
67 . . . S ENSGL=$S(X:$P($G(^ENG(6914.3,X,0)),U),1:"")
68 . . . S ENFUND=$$GET1^DIQ(6914,ENDA,62)
69 . . . S ENI=5 ; number of lines needed to print item
70 . . . S ENPM=$P($G(^ENG(6914,ENDA,3)),U,6) S:ENPM]"" ENI=ENI+1
71 . . . S ENMAN=$E($$GET1^DIQ(6914,ENDA_",",1),1,30) S:ENMAN]"" ENI=ENI+1
72 . . . S ENMOD=$P($G(^ENG(6914,ENDA,1)),U,2) S:ENMOD]"" ENI=ENI+1
73 . . . S ENSERIAL=$P($G(^ENG(6914,ENDA,1)),U,3) S:ENSERIAL]"" ENI=ENI+1
74 . . . I IOM'>89,$P(ENY2,U,13)]"" S ENI=ENI+1
75 . . . I $Y+ENI>IOSL D HD Q:END D HDCSN
76 . . . W !!,?1,ENDA ; equipment id
77 . . . W ?12,$E($P(ENY2,U,4),4,5),?14,"/",$E($P(ENY2,U,4),2,3) ; acq date
78 . . . W ?18,ENFUND ; fund
79 . . . W ?25,ENSGL ; sgl
80 . . . W ?30,$J("$"_$FN($P(ENY2,U,3),",",2),14) ; asset value
81 . . . W ?45,$P(ENY2,U,6) ; le
82 . . . W ?48,$E($P(ENY2,U,10),4,5),?50,"/",$E($P(ENY2,U,10),2,3) ; repl
83 . . . W ?54,$$GET1^DIQ(6914,ENDA,24) ; location
84 . . . W ?74,ENCMR ; cmr
85 . . . I IOM>89,$P(ENY2,U,13)]"" W ?80,$$FMTE^XLFDT($P(ENY2,U,13),2)
86 . . . W:ENPM]"" !,?4,"PM: ",ENPM
87 . . . W:ENMAN]"" !,?4,"Manf: ",ENMAN
88 . . . W:ENMOD]"" !,?4,"Model: ",ENMOD
89 . . . W:ENSERIAL]"" !,?4,"S/N: ",ENSERIAL
90 . . . I IOM'>89,$P(ENY2,U,13)]"" W !,?4,"Last Inv. Date: ",$$FMTE^XLFDT($P(ENY2,U,13),2)
91 . . . S:ENSGL="" ENSGL="<null>"
92 . . . S $P(ENT(ENSGL),U)=$P($G(ENT(ENSGL)),U)+1
93 . . . S $P(ENT(ENSGL),U,2)=$P($G(ENT(ENSGL)),U,2)+$P(ENY2,U,3)
94 . . . S $P(ENC,U)=$P($G(ENC),U)+1
95 . . . S $P(ENC,U,2)=$P($G(ENC),U,2)+$P(ENY2,U,3)
96 . Q:END
97 . W !,?13,"(CSN TOTAL",?24,$J("#"_$P(ENC,U),3)
98 . W ?30,$J("$"_$FN($P(ENC,U,2),",",2),14),")"
99 I END W !!,"REPORT STOPPED BY USER REQUEST"
100 E D
101 . ; report footer
102 . S ENSGL="",ENC=0 F S ENSGL=$O(ENT(ENSGL)) Q:ENSGL="" S ENC=ENC+1
103 . I $Y+ENC+6>IOSL D HD Q:END
104 . W !,ENL,!,"TOTALS",?20,"COUNT",?30,"ASSET VALUE"
105 . S ENT="0^0"
106 . S ENSGL="" F S ENSGL=$O(ENT(ENSGL)) Q:ENSGL="" D
107 . . W !,?9,"SGL ",ENSGL
108 . . W ?20,$J($P(ENT(ENSGL),U),5)
109 . . W ?30,"$",$J($FN($P(ENT(ENSGL),U,2),",",2),15)
110 . . S $P(ENT,U)=$P(ENT,U)+$P(ENT(ENSGL),U)
111 . . S $P(ENT,U,2)=$P(ENT,U,2)+$P(ENT(ENSGL),U,2)
112 . W !,?20,"-----",?30,"----------------"
113 . W !,?6,"REPORT TOTAL"
114 . W ?20,$J($P(ENT,U),5)
115 . W ?30,"$",$J($FN($P(ENT,U,2),",",2),15)
116 . I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR
117 D ^%ZISC
118EXIT I $D(ZTQUEUED) S ZTREQ="@"
119 K ^TMP($J)
120 K DIR,DIROUT,DIRUT,DIWF,DIWL,DTOUT,DUOUT,X,Y
121 K ENC,ENCMR,ENCMRI,ENCSN,ENCSNI,ENDA,ENFUND,ENI,ENMAN,ENMOD,ENPM
122 K ENSERIAL,ENSGL,ENSN,ENSND,ENSNR,ENT,ENY2
123 K END,ENDT,ENL,ENPG
124 Q
125HD ; header
126 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1,END=1 Q
127 I $E(IOST,1,2)="C-",ENPG S DIR(0)="E" D ^DIR K DIR I 'Y S END=1 Q
128 I $E(IOST,1,2)="C-"!ENPG W @IOF
129 S ENPG=ENPG+1
130 W !,$S(ENEXP:"ACCOUNTABLE",1:"CAPITALIZED")," NX EQUIP. FOR STATION: "
131 W ENSNR,?48,ENDT,?72,"page ",ENPG
132 W !!,?1,"EQUIPMENT",?12,"ACQ",?18,"FUND",?25,"SGL",?30,"ASSET VALUE"
133 W ?45,"LE",?48,"REPL",?54,"LOCATION",?74,"CMR"
134 W:IOM>89 ?80,"INVENTORY"
135 W !,?1,"ENTRY #",?12,"DATE",?48,"DATE",?54,"ROOM-BLDG-DIV"
136 W:IOM>89 ?80,"DATE"
137 W !,?1,$E(ENL,1,10),?12,$E(ENL,1,5),?18,$E(ENL,1,6),?25,$E(ENL,1,4)
138 W ?30,$E(ENL,1,14),?45,$E(ENL,1,2),?48,$E(ENL,1,5),?54,$E(ENL,1,19)
139 W ?74,$E(ENL,1,5)
140 W:IOM>89 ?80,$E(ENL,1,9)
141 Q
142HDCSN ; header for continued CSN
143 I $G(ENCSN)]"" D
144 . W ! W:$G(ENCSNI) $P($G(^ENCSN(6917,ENCSNI,0)),U,3)
145 . W " (CSN: ",ENCSN," continued)"
146 Q
147 ;ENFAR8
Note: See TracBrowser for help on using the repository browser.