source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENFAR1.m@ 1780

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1ENFAR1 ;WIRMFO/SAB-FIXED ASSET RPT, CAPITALIZED EQUIPMENT ON CMR; 3/11/96
2 ;;7.0;ENGINEERING;**25**;Aug 17, 1993
3 ; Capitalized Equipment List for CMR by CSN
4 ;
5CMR ; ask CMR
6 S DIC=6914.1,DIC(0)="AQEM" D ^DIC K DIC G:Y'>0 EXIT
7 S ENCMRI=+Y,ENCMR=$P(Y,U,2)
8 I $$LOC^ENFAVAL(ENCMR)="" D G CMR
9 . W $C(7),!,"CMR ",ENCMR," is inappropriate for capitalized NX equip."
10 . W !,"Please choose a different CMR.",!
11 ; ask device
12 S %ZIS="QM" D ^%ZIS G:POP EXIT
13 I $D(IO("Q")) D G EXIT
14 . S ZTRTN="QEN^ENFAR1",ZTDESC="Capitalized Equipment on CMR"
15 . S ZTSAVE("ENCMR")="",ZTSAVE("ENCMRI")=""
16 . D ^%ZTLOAD,HOME^%ZIS K ZTSK
17QEN ; queued entry
18 U IO
19 ; collect and sort equipment
20 K ^TMP($J)
21 S ENDA="" F S ENDA=$O(^ENG(6914,"AD",ENCMRI,ENDA)) Q:ENDA="" D
22 . Q:$P($G(^ENG(6914,ENDA,8)),U,2)'=1 ; not capitalized
23 . S ENCSNI=$P($G(^ENG(6914,ENDA,2)),U,8)
24 . S ENCSN=$S(ENCSNI:$P($G(^ENCSN(6917,ENCSNI,0)),U),1:"")
25 . I ENCSN="" S (ENCSN,ENCSNI)="<null value>"
26 . S ^TMP($J,ENCSN,ENDA)=""
27 . I $D(^TMP($J,ENCSN))#10=0 S ^TMP($J,ENCSN)=ENCSNI
28 ; generate output
29 K ENT
30 S (END,ENPG)=0 D NOW^%DTC S Y=% D DD^%DT S ENDT=Y
31 S ENL="",$P(ENL,"-",IOM)=""
32 S ENCSN="" D HD
33 F S ENCSN=$O(^TMP($J,ENCSN)) Q:ENCSN="" D Q:END
34 . ; category stock number
35 . S ENCSNI=$P($G(^TMP($J,ENCSN)),U)
36 . I $Y+4>IOSL D HD Q:END
37 . W !! W:ENCSNI $P($G(^ENCSN(6917,ENCSNI,0)),U,3) W " (CSN: ",ENCSN,")"
38 . S ENDA=0 F S ENDA=$O(^TMP($J,ENCSN,ENDA)) Q:'ENDA D Q:END
39 . . ; equipment item
40 . . I $Y+6>IOSL D HD Q:END D HDCSN
41 . . S ENY2=$G(^ENG(6914,ENDA,2))
42 . . S X=$P($G(^ENG(6914,ENDA,8)),U,6)
43 . . S ENSGL=$S(X:$P($G(^ENG(6914.3,X,0)),U),1:"")
44 . . W !!,?2,ENDA ; equip id
45 . . W ?13,$E($P($G(^ENG(6914,ENDA,1)),U,3),1,19) ; serial #
46 . . W ?33,$J("$"_$FN($P(ENY2,U,3),",",2),14) ; asset value
47 . . W ?48,ENSGL ; sgl
48 . . W ?53,$E($P(ENY2,U,4),4,5),?55,"/",$E($P(ENY2,U,4),2,3) ; acq date
49 . . W ?60,$P(ENY2,U,6) ; le
50 . . W ?64,$E($P(ENY2,U,10),4,5),?66,"/",$E($P(ENY2,U,10),2,3) ; repl
51 . . W ?71,$P(ENY2,U,7) ; nxrn
52 . . S ENPM=$P($G(^ENG(6914,ENDA,3)),U,6)
53 . . W:ENPM]"" !,?4,"PM: ",ENPM
54 . . S ENMAN=$E($$GET1^DIQ(6914,ENDA_",",1),1,30)
55 . . W:ENMAN]"" !,?4,"Manf: ",ENMAN
56 . . S ENMOD=$P($G(^ENG(6914,ENDA,1)),U,2)
57 . . W:ENMOD]"" !,?4,"Model: ",ENMOD
58 . . S:ENSGL="" ENSGL="<null>"
59 . . S $P(ENT(ENSGL),U)=$P($G(ENT(ENSGL)),U)+1
60 . . S $P(ENT(ENSGL),U,2)=$P($G(ENT(ENSGL)),U,2)+$P(ENY2,U,3)
61 I 'END D
62 . ; report footer
63 . S ENSGL="",ENC=0 F S ENSGL=$O(ENT(ENSGL)) Q:ENSGL="" S ENC=ENC+1
64 . I $Y+ENC+6>IOSL D HD Q:END
65 . W !,ENL,!,"TOTALS",?19,"COUNT",?27,"ASSET VALUE"
66 . S ENT="0^0"
67 . S ENSGL="" F S ENSGL=$O(ENT(ENSGL)) Q:ENSGL="" D
68 . . W !,?8,"SGL ",ENSGL
69 . . W ?19,$J($P(ENT(ENSGL),U),5)
70 . . W ?27,"$",$J($FN($P(ENT(ENSGL),U,2),",",2),15)
71 . . S $P(ENT,U)=$P(ENT,U)+$P(ENT(ENSGL),U)
72 . . S $P(ENT,U,2)=$P(ENT,U,2)+$P(ENT(ENSGL),U,2)
73 . W !,?19,"-----",?27,"----------------"
74 . W !,?5,"REPORT TOTAL"
75 . W ?19,$J($P(ENT,U),5),?27,"$",$J($FN($P(ENT,U,2),",",2),15)
76 . I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR
77 D ^%ZISC
78EXIT I $D(ZTQUEUED) S ZTREQ="@"
79 K ^TMP($J)
80 K DIR,DIROUT,DIRUT,DIWF,DIWL,DTOUT,DUOUT,X,Y
81 K ENC,ENCMR,ENCMRI,ENCSN,ENCSNI,ENDA,ENMAN,ENMOD,ENPM,ENSGL,ENT,ENY2
82 K END,ENDT,ENL,ENPG
83 Q
84HD ; header
85 I $E(IOST,1,2)="C-",ENPG S DIR(0)="E" D ^DIR K DIR I 'Y S END=1 Q
86 I $E(IOST,1,2)="C-"!ENPG W @IOF
87 S ENPG=ENPG+1
88 W !,"CAPITALIZED EQUIPMENT BY CSN FOR CMR: ",$E(ENCMR,1,5)
89 W ?48,ENDT,?72,"page ",ENPG
90 W !!,?2,"EQUIP ID #",?13,"SERIAL NUMBER",?33,"ASSET VALUE",?48,"SGL"
91 W ?53,"ACQ",?60,"LE",?64,"REPL",?71,"NXRN"
92 W !,?2,$E(ENL,1,10),?13,$E(ENL,1,19),?33,$E(ENL,1,14),?48,$E(ENL,1,4)
93 W ?53,$E(ENL,1,5),?60,$E(ENL,1,2),?64,$E(ENL,1,5),?71,$E(ENL,1,8)
94 Q
95HDCSN ; header for continued CSN
96 I $G(ENCSN)]"" D
97 . W ! W:$G(ENCSNI) $P($G(^ENCSN(6917,ENCSNI,0)),U,3)
98 . W " (CSN: ",ENCSN," continued)"
99 Q
100 ;ENFAR1
Note: See TracBrowser for help on using the repository browser.