source: FOIAVistA/trunk/r/ENGINEERING-EN/ENEQRPI.m@ 1611

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

initial load of FOIAVistA 6/30/08 version
File size: 7.7 KB
Line 
1ENEQRPI ;(WCIOFO)/DH,SAB-Equipment Inventory Listings ;10/12/1999
2 ;;7.0;ENGINEERING;**19,21,39,50,60,63**;Aug 17, 1993
3 ;
4HDR W @IOF,!!,"INVENTORY LISTING",!,"Version ",^ENG("VERSION"),! Q
5OUT K EN,ENSND Q
6 ;
7COM S DIC="^ENG(6914,",L=0
8 S DIOEND="I IO=IO(0),$E(IOST,1,2)=""C-"" R !,""Press <RETURN> to continue..."",X:DTIME"
9 I $D(^ENG(6910.2,"B","INVENTORY TEMPLATE")) S I=$O(^("INVENTORY TEMPLATE",0)) I I>0,$P(^ENG(6910.2,I,0),U,2)="L",$D(^DIPT("B","ENZEQ EQUIP. LIST")) S FLDS="[ENZEQ EQUIP. LIST]"
10 E S FLDS="[ENEQ EQUIP. LIST]"
11 Q
12 ;
13DTYP ;List by EQUIPMENT CATEGORY
14 D COM S BY="#6" D EN1^DIP G OUT
15 ;
16LOC ;List by LOCATION
17 D COM S BY=$S($D(^DIBT("B","ENZ LOCATION")):"[ENZ LOCATION]",1:"[EN LOCATION]") D EN1^DIP G OUT
18 ;
19SRV ;List by SERVICE POINTER
20 D COM S BY="#21" D EN1^DIP G OUT
21 ;
22SHOP ;List by RESPONSIBLE SHOP
23 W !!,"Important note: SHOP NAME(S) MUST BE ENTERED IN RESPONSE TO THE 'START WITH'",!,"AND 'GO TO' PROMPTS. NUMBERS WILL NOT BE UNDERSTOOD BY THE SORT LOGIC."
24 D COM S BY="#30,.01" D EN1^DIP G OUT
25 ;
26STUS ;List by USE STATUS
27 D COM S BY="#19,20" D EN1^DIP G OUT
28CMR ;Official CMR listing
29 ; input- (optional) $D(ENNXEXP) true when Non-Expendable Expensed rpt
30 S ENSND=$P($G(^DIC(6910,1,0)),U,2) ; default station #
31 I ENSND="" W !!,*7,"The Eng Init Parameters File must contain a STATION NUMBER. Can't proceed." G OUT
32 S DIC="^ENG(6914.1,",DIC(0)="AEQM",DIC("A")="Start WITH: "
33 D ^DIC K DIC G:+Y'>0 OUT
34 S EN("FR")=$P(^ENG(6914.1,+Y,0),U),EN("CMR",0)=+Y
35CMR1 ; ask go to
36 K EN("TO")
37 R !,"Go TO: ",X:DTIME G:X=""!($E(X)=U) OUT
38 I X=" " S EN("TO")=EN("FR") W " "_EN("TO")
39 I '$D(EN("TO")),$E(X)'="?" S:X]EN("FR")!(X=EN("FR")) EN("TO")=X
40 I '$D(EN("TO")) W $C(7),!!,"Please enter a CMR that does not preceed "_EN("FR")_"." G CMR1
41 ; if range then ask station number
42 S EN("STA")="ALL" I EN("TO")]EN("FR") D G:$D(DIRUT) OUT
43 . S DIR(0)="Y"
44 . S DIR("A")="Do you want to just print CMRs for a specific station"
45 . S DIR("B")="NO"
46 . S DIR("?",1)="Answer YES if you only want to print CMRs that have a"
47 . S DIR("?",2)="specific value in their station number field. If the"
48 . S DIR("?",3)="CMR's station number is blank, then it will be assumed"
49 . S DIR("?",4)="to be "_ENSND_"."
50 . S DIR("?",5)=" "
51 . S DIR("?")="Enter either 'Y' or 'N'."
52 . D ^DIR K DIR Q:'Y!$D(DIRUT)
53 . S DIR(0)="6914.1,5",DA=EN("CMR",0)
54 . D ^DIR K DIR Q:$D(DIRUT)
55 . S EN("STA")=Y
56 ; ask comments
57 S DIR(0)="Y",DIR("A")="Should the COMMENTS field be printed"
58 S DIR("B")="NO"
59 D ^DIR K DIR G:$D(DIRUT) OUT S EN("COM")=Y
60 ; ask device
61 D DEV^ENLIB G:POP OUT
62 I $D(IO("Q")) D G OUT
63 . S ZTRTN="CMR1A^ENEQRPI",ZTDESC="CMR LISTING"
64 . S ZTSAVE("ENNXEXP")=""
65 . S ZTSAVE("EN(""FR"")")="",ZTSAVE("EN(""TO"")")=""
66 . S ZTSAVE("EN(""STA"")")="",ZTSAVE("EN(""COM"")")=""
67 . S ZTSAVE("ENSND")="",ZTSAVE("EN(""CMR"",0)")=""
68 . D ^%ZTLOAD K ZTSK D HOME^%ZIS
69CMR1A ; queued entry point
70 S EN("IOP")=ION
71 S EN("CMR")=EN("FR")
72 I EN("STA")'="ALL" D I EN("CMR",5)'=EN("STA") G CMR2A
73 . S EN("CMR",5)=$$GET1^DIQ(6914.1,EN("CMR",0),5) ; station number
74 . I EN("CMR",5)="" S EN("CMR",5)=ENSND ; default station #
75CMR2 ; cmr loop
76 S DIC="^ENG(6914,",L=0
77 S IOP=EN("IOP"),BY=$S($D(^DIBT("B","ENZCMR")):"[ENZCMR]",1:"[ENCMR]")
78 I '$D(ENNXEXP) D ; CMR report
79 . I EN("COM") S FLDS=$S($D(^DIPT("B","ENZCMRC")):"[ENZ",1:"[EN")_"CMRC]"
80 . E S FLDS=$S($D(^DIPT("B","ENZCMR")):"[ENZ",1:"[EN")_"CMR]"
81 . S DHD=$S($D(^DIPT("B","ENZCMR HD")):"[ENZCMR HD]",1:"[ENCMR HD]")
82 . S DHIT="D CMRCMP^ENEQRPI,CMRTOT^ENEQRPI"
83 . S DIOEND="D:$D(ENT) SUM^ENEQCMR D:$D(ENCSN) SIG^ENEQCMR I IO=IO(0),$E(IOST,1,2)=""C-"" R !,""Press <RETURN> to continue..."",X:DTIME"
84 . ; accountable equipment only (patch EN*7*63)
85 . S DIS(0)="I ""^1^A^""[(U_$P($G(^ENG(6914,D0,8)),U,2)_U)"
86 . ;S DIS(0)="I $P($G(^ENG(6914,D0,8)),U,2)!(""^10^23^70^""[(U_$S($P($G(^ENG(6914,D0,2)),U,8):$E($P($G(^ENCSN(6917,$P(^ENG(6914,D0,2),U,8),0)),U),1,2),1:"""")_U))" ; capitalized or adp, vech, or firearm
87 I $D(ENNXEXP) D ; NON-EXPENDABLE (EXPENSED) report
88 . I EN("COM") S FLDS=$S($D(^DIPT("B","ENZEXPC")):"[ENZ",1:"[EN")_"EXPC]"
89 . E S FLDS=$S($D(^DIPT("B","ENZEXP")):"[ENZ",1:"[EN")_"EXP]"
90 . S DHD=$S($D(^DIPT("B","ENZEXP HD")):"[ENZEXP HD]",1:"[ENEXP HD]")
91 . S DHIT="D CMRCMP^ENEQRPI"
92 . S DIOEND="I IO=IO(0),$E(IOST,1,2)=""C-"" R !,""Press <RETURN> to continue..."",X:DTIME"
93 . ; only not accountable (patch EN*7*63)
94 . S DIS(0)="I ""^1^A^""'[(U_$P($G(^ENG(6914,D0,8)),U,2)_U)"
95 . ;S DIS(0)="I '$P($G(^ENG(6914,D0,8)),U,2)&'(""^10^23^70^""[(U_$S($P($G(^ENG(6914,D0,2)),U,8):$E($P($G(^ENCSN(6917,$P(^ENG(6914,D0,2),U,8),0)),U),1,2),1:"""")_U))" ; not capitalized and not adp, vech, or firearm
96 S (TO,FR)=EN("CMR")
97 S EN("CMR",0)=$O(^ENG(6914.1,"B",EN("CMR"),0)) ; CMR ien
98 S EN("CMR",.5)=$$GET1^DIQ(6914.1,EN("CMR",0),.5) ; service
99 S EN("CMR",.6)=$$GET1^DIQ(6914.1,EN("CMR",0),.6) ; brief desc
100 S EN("CMR",1)=$$GET1^DIQ(6914.1,EN("CMR",0),1) ; resp official
101 S EN("CMR",5)=$$GET1^DIQ(6914.1,EN("CMR",0),5) ; station number
102 I EN("CMR",5)="" S EN("CMR",5)=ENSND ; default station #
103 S EN("CMR","HD")=EN("CMR")
104 S:EN("CMR",.5)]"" EN("CMR","HD")=EN("CMR","HD")_" "_EN("CMR",.5)_" SERVICE"
105 S:EN("CMR",.6)]"" EN("CMR","HD")=EN("CMR","HD")_" "_EN("CMR",.6)
106 S:EN("CMR",1)]"" EN("CMR","HD")=EN("CMR","HD")_" "_EN("CMR",1)
107 K ENCSN,ENT D EN1^DIP K ENCSN,ENT
108 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 G OUT ; aborted by user request
109CMR2A ; determine next CMR in loop (use B1 x-ref for acsii collating sequence)
110 S EN("X")=$O(^ENG(6914.1,"B1",$E(EN("CMR"),1,29)_" "))
111 S EN("I")=$S(EN("X")]"":$O(^ENG(6914.1,"B1",EN("X"),0)),1:"")
112 S EN("CMR")=$S(EN("I"):$P($G(^ENG(6914.1,EN("I"),0)),U),1:"")
113 I EN("CMR")=""!(EN("CMR")]EN("TO")) G OUT
114 I EN("STA")'="ALL" D I EN("STA")'=EN("CMR",5) G CMR2A
115 . S EN("CMR",5)=$$GET1^DIQ(6914.1,EN("I"),5) ; station #
116 . I EN("CMR",5)="" S EN("CMR",5)=ENSND ; default station #
117 I ION=EN("IOP"),$E(IOST,1,2)="C-" S DIR(0)="Y",DIR("A")="Continue to another EIL ("_EN("CMR")_")",DIR("B")="YES" D ^DIR K DIR G:'Y OUT
118 G CMR2
119 ;
120CMRNOM ; Print CSN Nomenclature on CMR (called from ENCMR print template)
121 Q:'$D(D0)
122 I '$D(ENCSN) S ENCSN=$P($G(^ENG(6914,D0,2)),U,8) D CMRNOMP Q
123 Q:$P($G(^ENG(6914,D0,2)),U,8)=ENCSN
124 S ENCSN=$P($G(^ENG(6914,D0,2)),U,8) D CMRNOMP
125 Q
126CMRNOMP ; prints nomenclature when CSN changes
127 Q:ENCSN=""
128 Q:'$D(^ENCSN(6917,ENCSN,0))
129 N X,DIWL,DIWR,DIWF,ENI
130 K ^UTILITY($J,"W") S DIWL=1,DIWR=IOM,DIWF="W"
131 W !!,"CATEGORY STOCK NUMBER: ",$P(^ENCSN(6917,ENCSN,0),U)
132 W " (",$P(^ENCSN(6917,ENCSN,0),U,3),")"
133 S ENI=0
134 F S ENI=$O(^ENCSN(6917,ENCSN,1,ENI)) Q:'ENI I $D(^(ENI,0)) S X=^(0) D ^DIWP
135 D ^DIWW
136 Q
137CMRCMP ; List components of equipment on CMR (called by DHIT)
138 Q:'$D(D0)
139 N ENDA,ENVAL
140 ; print components
141 S ENDA=0
142 F S ENDA=$O(^ENG(6914,"AE",D0,ENDA)) Q:'ENDA D
143 . W ?9,"COMPONENT ENTRY #: ",ENDA
144 . W ?40,$E($P($G(^ENG(6914,ENDA,0)),U,2),1,20)
145 . S ENVAL=$P($G(^ENG(6914,ENDA,2)),U,3)
146 . I ENVAL]"" W ?61,$J("$"_$FN(ENVAL,"",2),12) W ! Q
147 . S ENVAL=$P($G(^ENG(6914,ENDA,2)),U,12)
148 . I ENVAL]"" W ?61,$J("$"_$FN(ENVAL,"",2),12)," LEASE"
149 . W !
150 Q
151CMRTOT ; Maintain totals for CMR (called by DHIT)
152 ; add value to totals
153 ; input
154 ; D0 - ien of equipment entry
155 ; ENSND - default station number (from 6910)
156 ; optional ENT(station,fund,sgl)=count^lease cost^asset value
157 ; output
158 ; ENT(
159 Q:'$D(D0)
160 N ENSN,ENFUND,ENSGL,ENY
161 S ENY(2)=$G(^ENG(6914,D0,2))
162 S ENY(8)=$G(^ENG(6914,D0,8))
163 S ENY(9)=$G(^ENG(6914,D0,9))
164 S ENSN=$P(ENY(9),U,5)
165 I $P(ENY(8),U,2) S ENFUND=$P(ENY(9),U,7),ENSGL=$P(ENY(8),U,6)
166 I '$P(ENY(8),U,2) S ENFUND="<null>",ENSGL=10
167 I ENSN="",$G(ENSND)]"" S ENSN=ENSND
168 S:ENSN="" ENSN="<null>"
169 S:ENFUND="" ENFUND="<null>"
170 S:ENSGL="" ENSGL="<null>"
171 S $P(ENT(ENSN,ENFUND,ENSGL),U)=$P($G(ENT(ENSN,ENFUND,ENSGL)),U)+1
172 S $P(ENT(ENSN,ENFUND,ENSGL),U,2)=$P($G(ENT(ENSN,ENFUND,ENSGL)),U,2)+$P(ENY(2),U,12)
173 S $P(ENT(ENSN,ENFUND,ENSGL),U,3)=$P($G(ENT(ENSN,ENFUND,ENSGL)),U,3)+$P(ENY(2),U,3)
174 Q
175 ;
176 ;ENEQRPI
Note: See TracBrowser for help on using the repository browser.