source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCVMON.m@ 1006

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

initial load of WorldVistAEHR

File size: 7.7 KB
Line 
1PRCVMON ;ISC-SF/GJW;Monitor subscriptions ; 6/6/05 3:48pm
2 ;;5.1;IFCAP;**81**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;
6INIT ;Create initial set of FCP balances
7 N I,J,K,IENS,OUT,STAT,FCP
8 N IENS1,BAL,NODE
9 S I=""
10 F S I=$O(^PRCV(414.03,"AC",1,I)) Q:I="" D
11 .S IENS=I_","
12 .D GETS^DIQ(414.03,IENS,"@;.01;.02","I","OUT")
13 .S STAT=$G(OUT(414.03,IENS,.01,"I"))
14 .S FCP=$G(OUT(414.03,IENS,.02,"I"))
15 .K OUT
16 .S J=0
17 .;The pattern match is needed because IENs in this subfile
18 .;are actually strings, not (canonic) numbers
19 .F S J=$O(^PRC(420,STAT,1,FCP,4,J)) Q:((J="")!(J?1.A)) D
20 ..;Unfortunately, an IEN of "00" confuses Fileman, so it is
21 ..;necessary to use a global read instead of a Fileman call.
22 ..I $$FY4(J)'<$$GETFY D
23 ...S NODE=$G(^PRC(420,STAT,1,FCP,4,J,0))
24 ...F K=1:1:4 D
25 ....S BAL(K)=+$P(NODE,"^",K+1)
26 ...D UPD(STAT,FCP,J,.BAL)
27 Q
28 ;
29 ;Reset values to contents of PRCVAL
30RESET(PRCVAL) ;
31 N STAT,FCP,FY,I,MYBAL
32 S STAT=""
33 F S STAT=$O(@PRCVAL@(STAT)) Q:STAT="" D
34 .S FY=""
35 .F S FY=$O(@PRCVAL@(STAT,FY)) Q:FY="" D
36 ..I $$FY4(FY)'<$$GETFY D
37 ...S FCP=""
38 ...F S FCP=$O(@PRCVAL@(STAT,FY,FCP)) Q:FCP="" D
39 ....F I=1:1:4 D
40 .....S MYBAL(I)=$G(@PRCVAL@(STAT,FY,FCP,I))
41 ....;update 414.03
42 ....D UPD(STAT,FCP,FY,.MYBAL)
43 Q
44 ;
45 ;Schedule the task
46SCHED ;
47 N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTPRI,ZTSK
48 ;Quit if not a DM site
49 I '$$CHK D Q
50 .W !,"This task may not be scheduled at a non-Dynamed site."
51 I $$ISRUN D Q
52 .W !,$C(7),"The FCP monitor is already running!"
53 ;
54 ;Go ahead and schedule the task
55 S ZTRTN="RUN^PRCVMON"
56 S ZTDESC="FCP Balance Monitor"
57 S ZTDTH=$H ;right now
58 S ZTIO=""
59 S ZTPRI=3
60 D ^%ZTLOAD
61 D ISQED^%ZTLOAD
62 I $L($G(ZTSK(0)))>0 D
63 .D SETRUN(1)
64 .W !,"The FCP monitor (task # ",$G(ZTSK),") was scheduled"
65 .W " to run at ",$$HTE^XLFDT(ZTSK("D"))
66 Q
67 ;
68DIFF(PRCVX,PRCVY) ;
69 N T1,T2,VAL
70 ;check for wrap-around
71 I PRCVY<PRCVX D
72 .S T1=86400-PRCVX
73 .S T2=PRCVY
74 .S VAL=T1+T2
75 Q:PRCVY<PRCVX VAL
76 S VAL=PRCVY-PRCVX
77 Q VAL
78 ;
79RUN ;
80 N STAT,FCP,OUT,OUT1,OUT2,FY,FY2,FYIEN,VAL,VAL2,DELTA
81 N I,J,K,IX,IENS,IENS1,IENS2,IENS3,MROOT,PRCVQUIT
82 S PRCVSTRT=$P($H,",",2)
83 S DELTA=0
84 ;Quit if not a DM site
85 I '$$CHK D Q
86 .D SETRUN(0)
87 N $ET,$ES S $ET="D TRAP^PRCVMON"
88 ;
89 D INIT ;initialize 414.03 from 420 (one time only)
90 S PRCVQUIT=0
91 ;loop through the active subscriptions
92LOOP ;
93 H 1 ;breathing room
94 ;Asked to stop?
95 S:$D(PRCVEND) DELTA=+$G(DELTA)+$$DIFF(PRCVSTRT,PRCVEND)
96 I +$G(DELTA)'<120 D
97 .I $$S^%ZTLOAD S PRCVQUIT=1
98 .I $$SHLDSTP S PRCVQUIT=1
99 .S PRCVSTRT=$P($H,",",2)
100 .S DELTA=0
101 G:PRCVQUIT DONE
102ONCE ;
103 S VAL=$NA(^TMP("PRCVAL",$J)) ;values from 420
104 S VAL2=$NA(^TMP("PRCVAL2",$J)) ;values from 414.03
105 ;
106 ;for each subscription type
107 S I=""
108 F S I=$O(^PRCV(414.03,"AC",1,I)) Q:I="" D
109 .S IENS=I_","
110 .D GETS^DIQ(414.03,IENS,"@;.01;.02","I","OUT")
111 .S STAT=$G(OUT(414.03,IENS,.01,"I"))
112 .S FCP=$G(OUT(414.03,IENS,.02,"I"))
113 .K OUT
114 .;get a list of values from file 420
115 .S IENS1=","_FCP_","_STAT_","
116 .D LIST^DIC(420.06,IENS1,"@;.01;1;2;3;4","P",,,,"B",,,"OUT1")
117 .S J=""
118 .F S J=$O(OUT1("DILIST",J)) Q:J="" D
119 ..S FYIEN=$P($G(OUT1("DILIST",J,0)),"^",1)
120 ..S FY=$P($G(OUT1("DILIST",J,0)),"^",2)
121 ..I $$FY4(FY)'<$$GETFY D
122 ...S @VAL@(STAT,FY,FCP,1)=$P($G(OUT1("DILIST",J,0)),"^",3)
123 ...S @VAL@(STAT,FY,FCP,2)=$P($G(OUT1("DILIST",J,0)),"^",4)
124 ...S @VAL@(STAT,FY,FCP,3)=$P($G(OUT1("DILIST",J,0)),"^",5)
125 ...S @VAL@(STAT,FY,FCP,4)=$P($G(OUT1("DILIST",J,0)),"^",6)
126 .K OUT1
127 .S K=0
128 .F S K=$O(^PRCV(414.03,I,1,K)) Q:+K'>0 D
129 ..S IENS2=K_","_I_","
130 ..S FY2=$$GET1^DIQ(414.031,IENS2,.01)
131 ..S IENS3=","_IENS2
132 ..D LIST^DIC(414.0311,IENS3,"@;.01;1","P",,,,"B",,,"OUT2","MROOT")
133 ..I $$FY4(FY2)'<$$GETFY D
134 ...F IX=1:1:4 D
135 ....S @VAL2@(STAT,FY2,FCP,IX)=$P($G(OUT2("DILIST",IX,0)),"^",3)
136 ...K OUT2
137 ;Reset the values in 414.03
138 ;The old values are not needed, as they have been captured in ^TMP.
139 D RESET(VAL)
140 ;Now, compare the values
141 D COMP2(VAL,VAL2)
142 K @VAL,@VAL2
143 H 10 ;breathing room
144 S PRCVEND=$P($H,",",2) ;seconds since midnight
145 Q:'$D(PRCVQUIT)
146 G LOOP
147DONE ;
148 K PRCVSTRT,PRCVEND
149 D SETRUN(0)
150 Q
151 ;
152COMP2(PRCVNEW,PRCVOLD) ;
153 N STAT,FY,FCP,PRCVTMP1,PRCVTMP2
154 S STAT=""
155 F S STAT=$O(@PRCVNEW@(STAT)) Q:STAT="" D
156 .S FY=""
157 .F S FY=$O(@PRCVNEW@(STAT,FY)) Q:FY="" D
158 ..S FCP=""
159 ..F S FCP=$O(@PRCVNEW@(STAT,FY,FCP)) Q:FCP="" D
160 ...K PRCVTMP1,PRCVTMP2
161 ...M PRCVTMP1=@PRCVNEW@(STAT,FY,FCP)
162 ...M PRCVTMP2=@PRCVOLD@(STAT,FY,FCP)
163 ...D CHECK(.PRCVTMP1,.PRCVTMP2,STAT,FY,FCP)
164 K PRCVTMP1,PRCVTMP2
165 Q
166 ;
167CHECK(PRCVNBAL,PRCVOBAL,PRCVSTAT,PRCVFY,PRCVCP) ;
168 N I,CHG
169 Q:$$FY4(PRCVFY)<$$GETFY ;don't send anything for past years
170 S CHG=0 ;assume no change
171 F I=1:1:4 I +$G(PRCVNBAL(I))'=+$G(PRCVOBAL(I)) S CHG=1
172 I CHG D SEND(PRCVSTAT,PRCVFY,PRCVCP,.PRCVNBAL)
173 Q
174 ;
175SEND(PRCVSTAT,PRCVFY,PRCVCP,PRCVBAL) ;
176 N OBJ,PROTO,MYOPTNS,MYRES
177 S OBJ=$NA(^TMP($J,"PRCV_FBAL"))
178 S @OBJ@("TIME")=$$NOW^XLFDT
179 S @OBJ@("STAT")=$G(PRCVSTAT)
180 S @OBJ@("FCP_NUM")=$G(PRCVCP)
181 S @OBJ@("FY")=$G(PRCVFY)
182 S @OBJ@("1QBAL")=$G(PRCVBAL(1))
183 S @OBJ@("2QBAL")=$G(PRCVBAL(2))
184 S @OBJ@("3QBAL")=$G(PRCVBAL(3))
185 S @OBJ@("4QBAL")=$G(PRCVBAL(4))
186 D BLD1^PRCVBLD(OBJ)
187 S PROTO="PRCV_DYNAMED_22_EV_FUND_BAL_DATA"
188 S MYOPTNS("NAMESPACE")="PRCV"
189 D GENERATE^HLMA(PROTO,"GM",1,.MYRES,,.MYOPTNS)
190 K @OBJ
191 Q
192 ;
193 ;Update 414.03
194UPD(PRCVSTAT,PRCVFCP,PRCVFY,PRCVBAL) ;
195 N OUT,VAL,IEN,IENS1,IENS2,MYFDA,I
196 N MROOT
197 S VAL(1)=PRCVSTAT
198 S VAL(2)=PRCVFCP
199 S VAL(3)=1
200 D FIND^DIC(414.03,,"@;.01;.02;.03","KX",.VAL,,,,,"OUT","MROOT")
201 S IEN=$G(OUT("DILIST",2,1))
202 S IENS1="?+1"_","_IEN_","
203 S MYFDA(414.031,IENS1,.01)=PRCVFY
204 S I=""
205 F S I=$O(PRCVBAL(I)) Q:I="" D
206 .S IENS2="?+"_(I+1)_","_IENS1
207 .S MYFDA(414.0311,IENS2,.01)=I
208 .S MYFDA(414.0311,IENS2,1)=$G(PRCVBAL(I))
209 D UPDATE^DIE("EK","MYFDA",,"MROOT")
210 Q
211 ;
212TRAP ;
213 ;clear the 'run' flag
214 D SETRUN(0)
215 ;Have the temporary globals been deleted?
216 S VAL=$G(VAL),VAL2=$G(VAL2)
217 I VAL?1"^".E1"(".E K @VAL
218 I VAL2?1"^".E1"(".E K @VAL2
219 D ^%ZTER
220 D UNWIND^%ZTER
221 Q
222 ;
223 ;Provide a convenient way to enable/disable monitor
224GETSTAT() ;
225 N PRMY,IENS
226 S PRMY=$$PSTAT
227 S IENS=PRMY_","
228 Q +$$GET1^DIQ(411,IENS,106,"I")
229 ;
230SETSTAT(PRCVST) ;
231 N FDA,IENS,PRMY,STATE
232 S PRCVST=$G(PRCVST)
233 S STATE=$$EXTERNAL^DILFD(411,106,,PRCVST)
234 I STATE="" D Q
235 .W:IO=IO(0) !,"Invalid status!"
236 W:IO=IO(0) !,"Setting status to ",STATE
237 S PRMY=$$PSTAT
238 S IENS=PRMY_","
239 S FDA(411,IENS,106)=PRCVST
240 D UPDATE^DIE("","FDA")
241 Q
242 ;
243SETRUN(PRCVST) ;
244 N FDA,IENS,PRMY
245 S PRCVST=+$G(PRCVST)
246 Q:((PRCVST'=0)&(PRCVST'=1))
247 S PRMY=$$PSTAT
248 S IENS=PRMY_","
249 S FDA(411,IENS,107)=PRCVST
250 D UPDATE^DIE("","FDA")
251 Q
252ISRUN() ;
253 N PRMY,IENS
254 S PRMY=$$PSTAT
255 S IENS=PRMY_","
256 Q +$$GET1^DIQ(411,IENS,107,"I")
257 ;
258GETFY() ;
259 N DATE,YEAR,MON,FY
260 ;Get the calendar year
261 S DATE=$$DT^XLFDT
262 S YEAR=($E(DATE,1)+17)*100+$E(DATE,2,3)
263 S MON=+$E(DATE,4,5)
264 S FY=$S(MON>9:YEAR+1,1:YEAR)
265 Q FY
266 ;
267FY4(PRCVFY) ;
268 I $L(PRCVFY)'<4 Q PRCVFY
269 I +$G(PRCVFY)'<30 Q 1900+PRCVFY
270 Q 2000+PRCVFY
271 ;
272 ;Various simple checks
273CHK() ;
274 Q $$GET^XPAR("SYS","PRCV COTS INVENTORY",1,"Q")
275 ;
276 ;Primary station
277PSTAT() ;
278 N PRMY
279 I '$D(^PRC(411,"AC","Y")) Q 0 ;no primary station in x-ref
280 Q $O(^PRC(411,"AC","Y",""))
281 ;
282 ;Should the monitor stop?
283SHLDSTP() ;
284 N FLG
285 S FLG=$$GETSTAT
286 Q $S(FLG=0:1,FLG=1:0,FLG=2:1,1:1)
287 ;
288PUSH1(PRCVSTAT,PRCVFY,PRCVCP) ;
289 N OBJ,PROTO,MYOPTNS,MYRES
290 S OBJ=$NA(^TMP($J,"PRCV_FBAL"))
291 S @OBJ@("TIME")=$$NOW^XLFDT
292 S @OBJ@("STAT")=$G(PRCVSTAT)
293 S @OBJ@("FCP_NUM")=$G(PRCVCP)
294 S @OBJ@("FY")=$G(PRCVFY)
295 S @OBJ@("1QBAL")=+$P($G(^PRC(420,PRCVSTAT,1,PRCVCP,4,PRCVFY,0)),"^",2)
296 S @OBJ@("2QBAL")=+$P($G(^PRC(420,PRCVSTAT,1,PRCVCP,4,PRCVFY,0)),"^",3)
297 S @OBJ@("3QBAL")=+$P($G(^PRC(420,PRCVSTAT,1,PRCVCP,4,PRCVFY,0)),"^",4)
298 S @OBJ@("4QBAL")=+$P($G(^PRC(420,PRCVSTAT,1,PRCVCP,4,PRCVFY,0)),"^",5)
299 D BLD1^PRCVBLD(OBJ)
300 S PROTO="PRCV_DYNAMED_22_EV_FUND_BAL_DATA"
301 S MYOPTNS("NAMESPACE")="PRCV"
302 D GENERATE^HLMA(PROTO,"GM",1,.MYRES,,.MYOPTNS)
303 ;W:IO=IO(0) !,"Message generated: ",$P(MYRES,"^",1)
304 K @OBJ
305 Q
Note: See TracBrowser for help on using the repository browser.