source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENXOIPS.m@ 1501

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

initial load of WorldVistAEHR

File size: 9.3 KB
Line 
1ENXOIPS ;WIRMFO/SAB-POST INIT ;8.7.96
2 ;;7.0;ENGINEERING;**33**;AUG 17, 1993
3 ;
4 D BMES^XPDUTL("Performing Post-Init...")
5 ; set up fund conversion table
6 N ENFUNDT
7 S ENFUNDT(4537)="4537B"
8 S ENFUNDT(5014)="5014A1"
9 S ENFUNDT(8129)="8129G"
10 S ENFUNDT(8180)="8180S"
11 D MES^XPDUTL(" Updating NX FUND (#6914.6) names...")
12 K ENFDA
13 S ENDA=0 F S ENDA=$O(^ENG(6914.6,ENDA)) Q:'ENDA D
14 . S ENFUND=$P($G(^ENG(6914.6,ENDA,0)),U)
15 . I ENFUND]"",$D(ENFUNDT(ENFUND)) D
16 . . S ENFDA(6914.6,ENDA_",",.01)=ENFUNDT(ENFUND)
17 . . S:ENFUND=8129 ENFDA(6914.6,ENDA_",",1)="National Cemetery Gift Fund"
18 . . D MES^XPDUTL(" FUND "_ENFUND_" being changed to "_ENFUNDT(ENFUND))
19 I $D(ENFDA) D FILE^DIE("","ENFDA") D MSG^DIALOG()
20 D MES^XPDUTL(" Updating FUND values in FA DOCUMENT LOG")
21 S ENDA=0 F S ENDA=$O(^ENG(6915.2,ENDA)) Q:'ENDA D
22 . S ENFUND=$P($G(^ENG(6915.2,ENDA,3)),U,10)
23 . I ENFUND]"",$D(ENFUNDT(ENFUND)) S $P(^ENG(6915.2,ENDA,3),U,10)=ENFUNDT(ENFUND)
24 D MES^XPDUTL(" Updating FUND values in FR DOCUMENT LOG")
25 S ENDA=0 F S ENDA=$O(^ENG(6915.6,ENDA)) Q:'ENDA D
26 . S ENFUND=$P($G(^ENG(6915.6,ENDA,3)),U,9)
27 . I ENFUND]"",$D(ENFUNDT(ENFUND)) S $P(^ENG(6915.6,ENDA,3),U,9)=ENFUNDT(ENFUND)
28 K ENDA,ENFDA,ENFUND,ENFUNDT
29 D MES^XPDUTL(" Completed NX FUND changes")
30 ;
31 K ENX
32 S ENX(1)=" "
33 S ENX(2)=" The asset value of an equipment item in the Equipment Inventory"
34 S ENX(3)=" (#6914) file was not being correctly adjusted after creation of"
35 S ENX(4)=" an FC Document that changed the asset value of an earlier"
36 S ENX(5)=" FA Document to 0.00. The incorrect asset value would result"
37 S ENX(6)=" in the Voucher Summary report overstating the actual effect of"
38 S ENX(7)=" subsequent FD and FR Documents on the general ledger balance."
39 ;
40 S ENX(8)=" "
41 S ENX(9)=" The problem has been corrected by patch EN*7*33. This routine"
42 S ENX(10)=" will examine FAP Documents to identify any equipment entries"
43 S ENX(11)=" that were affected by the problem. If any equipment items are"
44 S ENX(12)=" identified, then this routine will make appropriate corrections."
45 S ENX(13)=" Any changes will be reported."
46 S ENX(14)=" "
47 D MES^XPDUTL(.ENX) K ENX
48 ;
49IDEQ ; loop thru FC DOCUMENT LOG to identify equipment that must be checked
50 D MES^XPDUTL(" Checking for FC Documents with value 0.00")
51 K ^TMP($J)
52 S ENC("EQ")=0 ; count of equipment
53 S ENI=0 F S ENI=$O(^ENG(6915.4,ENI)) Q:'ENI D
54 . Q:$P($G(^ENG(6915.4,ENI,3)),U,8)'="00" ; not FC to FA
55 . Q:$P($G(^ENG(6915.4,ENI,4)),U,6)']"" ; FC did not update value
56 . Q:$P($G(^ENG(6915.4,ENI,4)),U,6) ; FC not 0 value
57 . ; this FC Document would have been incorrecly processed
58 . ; save the associated equipment entry for later
59 . S ENDA=$P($G(^ENG(6915.4,ENI,0)),U)
60 . I ENDA,'$D(^TMP($J,ENDA)) S ^TMP($J,ENDA)="",ENC("EQ")=ENC("EQ")+1
61 ;
62 I ENC("EQ")=0 D G EXIT
63 . D MES^XPDUTL(" No FC Documents found with betterment '00' and zero value.")
64 . D MES^XPDUTL(" No corrections are required.")
65 D MES^XPDUTL(" The asset values of "_ENC("EQ")_" equipment entries may have")
66 D MES^XPDUTL(" been incorrectly adjusted due to the fault. Checking further...")
67 ;
68CHKEQ ; check equipment
69 ; load FA Type -> SGL conversion table
70 K ENFATT S I=0 F S I=$O(^ENG(6914.3,I)) Q:'I S X=^(I,0) I $P(X,U)]"",$P(X,U,3)]"" S ENFATT($P(X,U,3))=$P(X,U)
71 S ENFAPDT=DT+1 ; initialize earliest date of a corrected FAP Document
72 ; loop thru identified equipment entries
73 S ENDA=0 F S ENDA=$O(^TMP($J,ENDA)) Q:'ENDA D
74 . D BMES^XPDUTL(" -----------------------------------------")
75 . D MES^XPDUTL(" Checking Equipment with Entry #"_ENDA)
76 . K ENVAL
77 . ; lock equipment entry
78 . L +^ENG(6914,ENDA):5 I '$T D MES^XPDUTL(" Someone else is editing this equipment item. Please reinstall this patch later.") Q
79 . ; obtain chrono list of FAP Documents for this equipment entry
80 . K ENDOC
81 . F ENFILE=6915.2:.1:6915.6 D
82 . . S ENI=0 F S ENI=$O(^ENG(ENFILE,"B",ENDA,ENI)) Q:'ENI D
83 . . . S ENDT=$$GET1^DIQ(ENFILE,ENI,1,"I")
84 . . . S:ENDT ENDOC(ENDT,ENFILE,ENI)=""
85 . ; loop thru chrono list of FAP Documents and check asset values
86 . S ENDT="" F S ENDT=$O(ENDOC(ENDT)) Q:ENDT="" D
87 . . S ENFILE="" F S ENFILE=$O(ENDOC(ENDT,ENFILE)) Q:ENFILE="" D
88 . . . S ENI=0 F S ENI=$O(ENDOC(ENDT,ENFILE,ENI)) Q:'ENI D
89 . . . . D @("DOC"_$P(ENFILE,".",2))
90 . ; now check current value in equipment file
91 . S ENVAL("EQ")=$P($G(^ENG(6914,ENDA,2)),U,3) ; equipment value
92 . S ENVAL("EX")=$$DEC^ENFAUTL(ENVAL("IFA")+ENVAL("FB")) ; expected value
93 . S ENVAL("CO")=$$DEC^ENFAUTL(ENVAL("FA")+ENVAL("FB")) ; correct value
94 . I ENVAL("CO")'=ENVAL("EQ") D
95 . . D BMES^XPDUTL(" The TOTAL ASSET VALUE in the Equipment file is "_ENVAL("EQ"))
96 . . D MES^XPDUTL(" The expected value due to the fault (based on FAP Documents) is "_ENVAL("EX"))
97 . . D MES^XPDUTL(" The correct value (based on FAP Documents) is "_ENVAL("CO"))
98 . . ;
99 . . D MES^XPDUTL(" Changing Equipment file to "_ENVAL("CO")_"...")
100 . . S DA=ENDA,DR="12////^S X=ENVAL(""CO"")",DIE="^ENG(6914," D ^DIE
101 . . I +$$CHKFA^ENFAUTL(ENDA) D BMES^XPDUTL(" NOTE: The equipment item is currently established in Fixed Assets.")
102 . . I '+$$CHKFA^ENFAUTL(ENDA) D BMES^XPDUTL(" NOTE: The equipment item is not currently established in Fixed Assets and") D MES^XPDUTL(" it's value can be edited on the first equipment screen.")
103 . D MES^XPDUTL(" Completed check of equipment with Entry #"_ENDA_".")
104 . ; unlock equipment item
105 . L -^ENG(6914,ENDA)
106 I ENFAPDT<DT D
107 . D BMES^XPDUTL("-----------------------------------------")
108 . D MES^XPDUTL("You may wish to reprint the Voucher Summary reports") D MES^XPDUTL("starting with "_$$FMTE^XLFDT($E(ENFAPDT,1,5)_"00")_" since adjustments have been made.")
109 D ^ENXOIPS1
110 D BMES^XPDUTL("Completed Post-Init.")
111EXIT ;
112 K ^TMP($J)
113 K ENC,ENDA,ENDT,ENFAPDT,ENFAT,ENFATT,ENFILE,ENFND,ENFNDN,ENI
114 K ENSGL,ENSN,ENSTN,ENTRC,ENTRN,ENVAL
115 Q
116DOC2 ; FA document
117 S ENTRC="FA"
118 S ENTRN=$E($$GET1^DIQ(ENFILE,ENI,10),1,9)
119 S ENSN=$E($$GET1^DIQ(ENFILE,ENI,24),1,5)
120 S ENFND=$$GET1^DIQ(ENFILE,ENI,29)
121 S ENFAT=$$GET1^DIQ(ENFILE,ENI,25)
122 S ENVAL=$$GET1^DIQ(ENFILE,ENI,53)
123 S (ENVAL("FA"),ENVAL("IFA"))=ENVAL,ENVAL("FB")=0 ; reset values
124 Q
125DOC3 ; FB document
126 S ENTRC="FB "_$$GET1^DIQ(ENFILE,ENI,23)
127 S ENTRN=$E($$GET1^DIQ(ENFILE,ENI,10),1,9)
128 S ENSN=$E($$GET1^DIQ(ENFILE,ENI,21),1,5)
129 S ENFAT=$$GET1^DIQ(ENFILE,ENI,22)
130 S ENVAL=$$GET1^DIQ(ENFILE,ENI,36)
131 S ENVAL("FB")=ENVAL("FB")+ENVAL ; increment FB value
132 Q
133DOC4 ; FC document
134 S ENTRC="FC "_$$GET1^DIQ(ENFILE,ENI,27)
135 S ENTRN=$E($$GET1^DIQ(ENFILE,ENI,10),1,9)
136 S ENSN=$E($$GET1^DIQ(ENFILE,ENI,25),1,5)
137 S ENFAT=$$GET1^DIQ(ENFILE,ENI,26)
138 S ENVAL=$$GET1^DIQ(ENFILE,ENI,54)
139 ; adjust value
140 I ENTRC["00",ENVAL]"" D
141 . I ENVAL S ENVAL("IFA")=ENVAL-ENVAL("FA")+ENVAL("IFA")
142 . S ENVAL("FA")=ENVAL
143 I ENTRC'["00",ENVAL]"" S ENVAL("FB")=ENVAL("FB")+(ENVAL-$$GET1^DIQ(ENFILE,ENI,103))
144 Q
145DOC5 ; FD document
146 S ENTRC="FD "_$$GET1^DIQ(ENFILE,ENI,100,"I")
147 S ENTRN=$E($$GET1^DIQ(ENFILE,ENI,10),1,9)
148 S ENSN=$E($$GET1^DIQ(ENFILE,ENI,27),1,5)
149 S ENFAT=$$GET1^DIQ(ENFILE,ENI,28)
150 S ENVAL=""
151 S ENVAL("FD")=$$GET1^DIQ(ENFILE,ENI,101) ; asset value at time of FD
152 S ENVAL("CO")=$$DEC^ENFAUTL(ENVAL("FA")+ENVAL("FB")) ; correct value
153 I ENVAL("CO")'=ENVAL("FD") D
154 . D BMES^XPDUTL(" FD-"_ENTRN_" asset value incorrectly recorded as "_ENVAL("FD"))
155 . D MES^XPDUTL(" Correct value calculated as "_ENVAL("CO"))
156 . D MES^XPDUTL(" Updating document log for FD-"_ENTRN_"...")
157 . S DR="101///^S X=ENVAL(""CO"")",DIE="^ENG(6915.5,",DA=ENI D ^DIE
158 . I ENDT<ENFAPDT S ENFAPDT=ENDT ; save earliest date of a corrected doc
159 . ; adjust balance
160 . S ENVAL("DIF")=ENVAL("CO")-ENVAL("FD")
161 . S ENVAL("DIF")=-ENVAL("DIF") ; FD deletes value
162 . D:ENVAL("DIF") ADJBAL
163 Q
164DOC6 ; FR document
165 S ENTRC="FR"
166 S ENTRN=$E($$GET1^DIQ(ENFILE,ENI,10),1,9)
167 S ENSN=$E($$GET1^DIQ(ENFILE,ENI,24),1,5)
168 S ENFNDN=$$GET1^DIQ(ENFILE,ENI,28) ; new fund
169 S ENFAT=$$GET1^DIQ(ENFILE,ENI,25)
170 S ENVAL=""
171 S ENVAL("FR")=$$GET1^DIQ(ENFILE,ENI,107)
172 S ENVAL("CO")=$$DEC^ENFAUTL(ENVAL("FA")+ENVAL("FB"))
173 I ENVAL("CO")'=ENVAL("FR") D
174 . D BMES^XPDUTL(" FR-"_ENTRN_" asset value incorrectly recorded as "_ENVAL("FR"))
175 . D MES^XPDUTL(" Correct value calculated as "_ENVAL("CO"))
176 . D MES^XPDUTL(" Updating document log for FR-"_ENTRN_"...")
177 . I ENDT<ENFAPDT S ENFAPDT=ENDT ; save earliest date of a corrected doc
178 . S DR="107///^S X=ENVAL(""CO"")",DIE="^ENG(6915.6,",DA=ENI D ^DIE
179 . S ENVAL("DIF")=ENVAL("CO")-ENVAL("FR")
180 . I ENFNDN]"",ENFND'=ENFNDN,ENVAL("DIF") D
181 . . D MES^XPDUTL(" Since this FR Document changed the FUND from "_ENFND_" to "_ENFNDN)
182 . . D MES^XPDUTL(" the $ balance will need to be adjusted.")
183 . . ; apply negative difference (ENVAL("DIF")) to the old fund
184 . . S ENVAL("DIF")=-ENVAL("DIF")
185 . . D ADJBAL
186 . . ; update fund for asset
187 . . S ENFND=ENFNDN
188 . . ; apply positive difference (ENVAL("DIF")) to the new fund
189 . . S ENVAL("DIF")=-ENVAL("DIF")
190 . . D ADJBAL
191 Q
192ADJBAL ; Adjust Balance
193 ; Input Variables
194 ; ENSN - 5 character station number (may be padded)
195 ; ENFND - Fund
196 ; ENFAT - FA Type
197 ; ENDT - data/time
198 ; ENVAL("DIF") - amount to adjust
199 S ENSTN=$TR(ENSN," ","")
200 S ENSGL("I")=$O(^ENG(6914.3,"B",ENFATT(ENFAT),0))
201 S ENFND("I")=$O(^ENG(6914.6,"B",ENFND,0))
202 D MES^XPDUTL(" Applying difference ("_ENVAL("DIF")_") to $ balance of SGL...")
203 D MES^XPDUTL(" Adjusting Station: "_ENSTN_" FUND: "_ENFND_" SGL: "_ENFATT(ENFAT)_" from "_$$FMTE^XLFDT($E(ENDT,1,5)_"00")_" by $"_$FN(ENVAL("DIF"),",",2))
204 D ADJBAL^ENFABAL(ENSTN,ENFND("I"),ENSGL("I"),$P(ENDT,"."),ENVAL("DIF"))
205 Q
206 ;ENXOIPS
Note: See TracBrowser for help on using the repository browser.