source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENLIB3.m@ 1604

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

initial load of WorldVistAEHR
File size: 6.7 KB
RevLine 
[613]1ENLIB3 ;WCIOFO/DH,SAB-Package Utilities (FAP) ;9/2/1998
2 ;;7.0;ENGINEERING;**25,33,35,37,39,46,57**;Aug 17,1993
3PO ; Populate appropriate equipment data from IFCAP purchase order.
4 ; Normally called when PO entered into Equipment File
5 ; Input Variables
6 ; X => PO#
7 ; DA => Equipment IEN
8 N BBFY,FCP,FSC,PO,PODATE
9 S PO("E")=X
10 ; make sure item has not been reported to FAP
11 I $D(^ENG(6915.2,"B",DA)),+$$CHKFA^ENFAUTL(DA) Q ; active FA Document
12 ; find P.O.
13 S PO("I")=$$FIND1^DIC(442,"","X",PO("E"),"C^B")
14 Q:'PO("I") ; couldn't find IFCAP P.O.
15 ; update Vendor Pointer when null
16 I $P($G(^ENG(6914,DA,2)),U)="" D
17 . S X=$$GET1^DIQ(442,PO("I"),5,"I")
18 . I X]"" S $P(^ENG(6914,DA,2),U)=X
19 ; update Acquisition Source when null
20 I $P($G(^ENG(6914,DA,2)),U,14)="" D
21 . S X=$$GET1^DIQ(442,PO("I"),8,"I")
22 . I X]"" S $P(^ENG(6914,DA,2),U,14)=X
23 ; update Service Pointer when null
24 I $P($G(^ENG(6914,DA,3)),U,2)="" D
25 . S X=$$GET1^DIQ(442,PO("I"),5.2,"I")
26 . I X]"" S $P(^ENG(6914,DA,3),U,2)=X,^ENG(6914,"AC",X,DA)=""
27 ; update Fund Control Point when null
28 S FCP=$$GET1^DIQ(442,PO("I"),1)
29 I $P($G(^ENG(6914,DA,8)),U,3)="" D
30 . I FCP]"" S $P(^ENG(6914,DA,8),U,3)=FCP
31 ; update Cost Center when null ***obsolete: now computed from CMR***
32 ;I $P($G(^ENG(6914,DA,8)),U,4)="" D
33 ;. S X=$$GET1^DIQ(442,PO("I"),2,"I")
34 ;. I X]"" S $P(^ENG(6914,DA,8),U,4)=X
35 ; check availability of data
36 S FSC=$P($$GET1^DIQ(6914,DA,18),"-")
37 S PODATE=$$GET1^DIQ(442,PO("I"),.1,"I")
38 S BBFY=$$GET1^DIQ(442,PO("I"),26,"I")
39 Q:FCP=""!(PODATE="")!(BBFY="")!(FSC'?4N) ; can't proceed
40 ;
41FAP N AO,BOC,BOCX,BUDFY,DEPT,DOCFY,ENI,ENX,ENY,EQUITY,FUND,FUNDX
42 N IENS,SGL,STATION
43 S STATION=$P($$GET1^DIQ(442,PO("I"),.01),"-")
44 S DOCFY=$E($E(PODATE,1,3)+$E(PODATE,4),2,3) ; 2 digit document FY
45 S BUDFY=$E(BBFY,1,3)+1700 ; 4 digit beginning budget FY
46 S DEPT=$E($$GET1^DIQ(6914,DA,19),1,2)
47 ; determine BOC
48 ; loop thru item multiple for item matching FSC
49 S ENI=0,BOC="",BOCX=""
50 F S ENI=$O(^PRC(442,PO("I"),2,ENI)) Q:'ENI D Q:BOC]""
51 . S IENS=ENI_","_PO("I")_","
52 . Q:$$GET1^DIQ(442.01,IENS,8)'=FSC
53 . S BOCX=$E($$GET1^DIQ(442.01,IENS,3.5),1,4)
54 . I BOCX]"" S BOC=$$BOCI(BOCX)
55 ; if not found then loop thru BOC multiple for a NX BOC
56 I BOC="" S ENI=0 F S ENI=$O(^PRC(442,PO("I"),22,ENI)) Q:'ENI D Q:BOC]""
57 . S IENS=ENI_","_PO("I")_","
58 . S BOCX=$E($$GET1^DIQ(442.041,IENS,.01),1,4)
59 . I BOCX]"" S BOC=$$BOCI(BOCX)
60 ; determine SGL
61 I $G(BOC)>0 S SGL=$P(^ENG(6914.4,BOC,0),U,3)
62 E S SGL=10 ;Expensed NX
63 ; determine AO and FUND
64 S X=$$ACC^PRC0C(STATION,FCP_U_DOCFY_U_BUDFY)
65 I $P(X,U)]"" S AO=$O(^ENG(6914.7,"B",$P(X,U),0))
66 I $P(X,U,5)]"" S FUND="",FUNDX=$P(X,U,5) D
67 . ; check for matching Fund table entry
68 . S FUND=$$FUNDI(FUNDX) Q:FUND]""
69 . ; then how about a Fund table entry that matches the 1st 5 char
70 . I $L(FUNDX)>5 S FUND=$$FUNDI($E(FUNDX,1,5)) Q:FUND]""
71 . ; then how about a Fund table entry that matches the 1st 4 char
72 . I $L(FUNDX)>4 S FUND=$$FUNDI($E(FUNDX,1,4)) Q:FUND]""
73 . ; then how about a Fund table entry whose associated fund field
74 . ; matches the 1st four char
75 . I $L(FUNDX)>3 S FUND=$$AFUNDI($E(FUNDX,1,4)) Q:FUND]""
76 . ; then how about a Fund table entry that starts with the 1st 4 char
77 . I $L(FUNDX)>3 S ENX=$E(FUNDX,1,4)_" " F D Q:ENX=""!(FUND]"")
78 . . S ENX=$O(^ENG(6914.6,"B",ENX)) ; next fund in table
79 . . I $E(ENX,1,4)'=$E(FUNDX,1,4) S ENX="" Q ; can stop looking
80 . . S FUND=$$FUNDI(ENX)
81 ;
82 I $G(FUND)="" D
83 . I DEPT="06" S FUND=2 Q ; CANTEEN
84 . I DEPT=56 S FUND=3 Q ; CWT
85 . ;S FUND=1 ; AMAF ; Stopped using AMAF with Patch EN*7*57 (9/98)
86 ;
87 ;I $G(AO)="" D ;Disabled at request of FMS (9/96)
88 ;. I DEPT>59,DEPT<69 S AO=4 Q
89 ;. I DEPT=57!(DEPT=58) S AO=5 Q
90 ;. I DEPT=72 S AO=2 Q
91 ;. S X=$E(STATION) I X=3 S AO=4 Q
92 ;. I "8^9"[X S AO=5 Q
93 ;. I "4^5^6"[X S AO=3
94 ;
95 S EQUITY=$S("^5^12^"[(U_$G(FUND)_U):3402,$G(AO)=3:3299,$G(AO)=4:3210,$G(AO)=5:3210,$G(AO)=7:3210,1:"")
96 ;
97 S ENY=$G(^ENG(6914,DA,8))
98 S:$P(ENY,U,6)="" $P(ENY,U,6)=$G(SGL)
99 S ^ENG(6914,DA,8)=ENY
100 ;
101 S ENY=$G(^ENG(6914,DA,9))
102 S:$P(ENY,U,6)="" $P(ENY,U,6)=$G(BOC)
103 S:$P(ENY,U,7)="" $P(ENY,U,7)=$G(FUND)
104 S:$P(ENY,U,8)="" $P(ENY,U,8)=$G(AO)
105 S:$P(ENY,U,9)="" $P(ENY,U,9)=$G(EQUITY)
106 S ^ENG(6914,DA,9)=ENY
107 Q
108 ;
109BOCI(ENBOC) ; Returns ien of active BOC or null value
110 N ENI,ENDT
111 S ENI=$S(ENBOC]"":$O(^ENG(6914.4,"B",ENBOC,0)),1:"")
112 ; check if deactivated
113 I ENI S ENDT=$P($G(^ENG(6914.4,ENI,0)),U,5) I ENDT]"",ENDT'>DT S ENI=""
114 Q ENI
115 ;
116FUNDI(ENFUND) ; Returns ien of active FUND or null value
117 N ENI,ENDT
118 S ENI=$S(ENFUND]"":$O(^ENG(6914.6,"B",ENFUND,0)),1:"")
119 ; check if deactivated
120 I ENI S ENDT=$P($G(^ENG(6914.6,ENI,0)),U,5) I ENDT]"",ENDT'>DT S ENI=""
121 Q ENI
122 ;
123TYPE N A,ENX I '$D(^ENG(6915.2,"B",DA)) Q
124 I $D(^ENG(6915.5,"B",DA)) S ENX=$$CHKFA^ENFAUTL(DA) Q:'$P(ENX,U)
125 S A(1)="This item has been reported to the Fixed Assets Package. TYPE"
126 S A(2)="cannot be changed until an FD document is processed."
127 D EN^DDIOL(.A)
128 K X
129 Q
130 ;
131CAP N A,ENX I '$D(^ENG(6915.2,"B",DA)) Q
132 I $D(^ENG(6915.5,"B",DA)) S ENX=$$CHKFA^ENFAUTL(DA) Q:'$P(ENX,U)
133 S A(1)="This item has been reported to the Fixed Assets Package. It cannot"
134 S A(2)="be expensed until an FD document is processed."
135 D EN^DDIOL(.A)
136 K X
137 Q
138 ;
139NX N A,ENX I '$D(^ENG(6915.2,"B",DA)) Q
140 I $D(^ENG(6915.5,"B",DA)) S ENX=$$CHKFA^ENFAUTL(DA) I '$P(ENX,U) Q
141 S A(1)="Since this item has been reported to FAP, this field may be edited"
142 S A(2)="only by means of an FAP document."
143 D EN^DDIOL(.A)
144 K X
145 Q
146 ;
147DTCHK(ENFLD) ;Input Transform Check that TURN-IN DATE, REPLACEMENT DATE, and
148 ; DISPOSITION DATE follow ACQUISITION DATE.
149 ; DA => Equipment Entry Number
150 ; ENFLD => Field being checked (16, 20.5, or 22)
151 ; X => value entered (internal format) - killed if check fails
152 I X'>$P($G(^ENG(6914,DA,2)),U,4) D K X ; failed check
153 . N ENLBL
154 . S ENLBL=$$GET1^DID(6914,ENFLD,"","LABEL")
155 . D EN^DDIOL(ENLBL_" must follow ACQUISITION DATE")
156 Q
157 ;
158DISPM ; Expand DISPOSITION METHOD on DJ screens ENEQ2*
159 ; Expects value (1U) in loc var V(V)
160 ; Returns expanded value in V(V)
161 ; Called by PRE-ACTION field of DJ Screen File
162 ;
163 Q:$G(V(V))'?1U N X
164 S X=$O(^ENG(6914.8,"B",V(V),0)) I X>0,$D(^ENG(6914.8,X,0)) S V(V)=V(V)_" "_$E($P(^(0),U,2),1,25)
165 Q
166 ;
167DISPW ; Prohibit direct edit of DISPOSITION METHOD for capitalized assets
168 ;
169 W !,"Capitalized asset. DISP METHOD may be edited only by means of FAP documents."
170 W !,"Press <RETURN> to continue..." R X:DTIME
171 Q
172 ;
173AFUNDI(ENFUND) ; Returns ien of active FUND or null value
174 ; input - associated fund
175 N ENI,ENJ,ENDT
176 S ENI=""
177 ; loop thru associated fund x-ref looking for active entry that matches
178 S ENJ=0
179 I ENFUND]"" F S ENJ=$O(^ENG(6914.6,"E",ENFUND,ENJ)) Q:'ENJ!(ENI]"") D
180 . ; check if deactivated
181 . S ENDT=$P($G(^ENG(6914.6,ENJ,0)),U,5) I ENDT]"",ENDT'>DT Q
182 . S ENI=ENJ ; found active fund entry for associated fund value
183 Q ENI
184 ;
185 ;ENLIB3
Note: See TracBrowser for help on using the repository browser.