source: FOIAVistA/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXQUTL3B.m@ 1423

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

initial load of FOIAVistA 6/30/08 version

File size: 7.7 KB
Line 
1PXQUTL3B ;ISL/JVS CLEAN OUT BAD XREF #3 ;6/9/97 09:05
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**29,35,100**;Aug 12, 1996
3 ;
4 Q
5O ;---OTHER V FILES
6 ;
7 N IMMCNT,SKCNT,XAMCNT,TRTCNT,PEDCNT,HFCNT
8 D I I Y="^" Q
9 D S I Y="^" Q
10 D X I Y="^" Q
11 D T^PXQUTL3C I Y="^" Q
12 D P^PXQUTL3C I Y="^" Q
13 D H^PXQUTL3C I Y="^" Q
14 Q
15 ;
16 ;
17I W !!,"Checking the V IMMUNIZATION FILE #9000010.11 ",!
18 S IMMCNT=0
19 I Y="^" Q
20 S I="" F S I=$O(^AUPNVIMM("B",I)) Q:I="" D Q:Y="^"
21 . S IEN="" F S IEN=$O(^AUPNVIMM("B",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D Q:Y="^"
22 ..S ARRAY="^AUPNVIMM(""B"",I,IEN)" S IMMCNT=IMMCNT+1 I IMMCNT#1000=2 D MON
23 ..I '$D(^AUPNVIMM(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVIMM(""B"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
24 ;
25 ;-----AD
26 S I="" F S I=$O(^AUPNVIMM("AD",I)) Q:I="" D Q:Y="^"
27 . S IEN="" F S IEN=$O(^AUPNVIMM("AD",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D Q:Y="^"
28 ..S ARRAY="^AUPNVIMM(""AD"",I,IEN)" S IMMCNT=IMMCNT+1 I IMMCNT#1000=2 D MON
29 ..I '$D(^AUPNVIMM(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVIMM(""AD"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
30 ;
31 ;-----C
32 S I="" F S I=$O(^AUPNVIMM("C",I)) Q:I="" D Q:Y="^"
33 . S IEN="" F S IEN=$O(^AUPNVIMM("C",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D Q:Y="^"
34 ..S ARRAY="^AUPNVIMM(""C"",I,IEN)" S IMMCNT=IMMCNT+1 I IMMCNT#1000=2 D MON
35 ..I '$D(^AUPNVIMM(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVIMM(""C"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
36 ;
37 ;-----AA
38 S I="" F S I=$O(^AUPNVIMM("AA",I)) Q:I="" D Q:Y="^"
39 . S IEN="" F S IEN=$O(^AUPNVIMM("AA",I,IEN)) Q:IEN="" D Q:Y="^"
40 ..S IENN="" F S IENN=$O(^AUPNVIMM("AA",I,IEN,IENN)) Q:IENN="" D Q:Y="^"
41 ...S IENNN="" F S IENNN=$O(^AUPNVIMM("AA",I,IEN,IENN,IENNN)) W:IENNN#1000=22 "." Q:IENNN="" D Q:Y="^"
42 ....S ARRAY="^AUPNVIMM(""AA"",I,IEN,IENN,IENNN)" S IMMCNT=IMMCNT+1 I IMMCNT#1000=2 D MON
43 ....I '$D(^AUPNVIMM(IENNN)) W !,"Entry "_IENNN," IS NOT THERE! BAD REFERENCE IS ^AUPNVIMM(""AA"","_I_",",IEN_","_IENN_","_IENNN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
44 Q
45 ;
46 ;
47 ;
48S W !!,"Checking the V SKIN TEST FILE #9000010.12 ",!
49 S SKCNT=0
50 I Y="^" Q
51 S I="" F S I=$O(^AUPNVSK("B",I)) Q:I="" D Q:Y="^"
52 . S IEN="" F S IEN=$O(^AUPNVSK("B",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D Q:Y="^"
53 ..S ARRAY="^AUPNVSK(""B"",I,IEN)" S SKCNT=SKCNT+1 I SKCNT#1000=2 D MON
54 ..I '$D(^AUPNVSK(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVSK(""B"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
55 S I="" F S I=$O(^AUPNVSK("AD",I)) Q:I="" D Q:Y="^"
56 . S IEN="" F S IEN=$O(^AUPNVSK("AD",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D Q:Y="^"
57 ..S ARRAY="^AUPNVSK(""AD"",I,IEN)" S SKCNT=SKCNT+1 I SKCNT#1000=2 D MON
58 ..I '$D(^AUPNVSK(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVSK(""AD"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
59 S I="" F S I=$O(^AUPNVSK("AE",I)) Q:I="" D Q:Y="^"
60 . S IEN="" F S IEN=$O(^AUPNVSK("AE",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D Q:Y="^"
61 ..S ARRAY="^AUPNVSK(""AE"",I,IEN)" S SKCNT=SKCNT+1 I SKCNT#1000=2 D MON
62 ..I '$D(^AUPNVSK(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVSK(""AE"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
63 S I="" F S I=$O(^AUPNVSK("C",I)) Q:I="" D Q:Y="^"
64 . S IEN="" F S IEN=$O(^AUPNVSK("C",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D Q:Y="^"
65 ..S ARRAY="^AUPNVSK(""C"",I,IEN)" S SKCNT=SKCNT+1 I SKCNT#1000=2 D MON
66 ..I '$D(^AUPNVSK(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVSK(""C"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
67 S I="" F S I=$O(^AUPNVSK("AA",I)) Q:I="" D Q:Y="^"
68 . S IEN="" F S IEN=$O(^AUPNVSK("AA",I,IEN)) Q:IEN="" D Q:Y="^"
69 ..S IENN="" F S IENN=$O(^AUPNVSK("AA",I,IEN,IENN)) Q:IENN="" D Q:Y="^"
70 ...S IENNN="" F S IENNN=$O(^AUPNVSK("AA",I,IEN,IENN,IENNN)) W:IENNN#1000=22 "." Q:IENNN="" D Q:Y="^"
71 ....S ARRAY="^AUPNVSK(""AA"",I,IEN,IENN,IENNN)" S SKCNT=SKCNT+1 I SKCNT#1000=2 D MON
72 ....I '$D(^AUPNVSK(IENNN)) W !,"Entry "_IENNN," IS NOT THERE! BAD REFERENCE IS ^AUPNVSK(""AA"","_I_",",IEN_","_IENN_","_IENNN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
73 Q
74 ;
75X W !!,"Checking the V EXAM FILE #9000010.13 ",!
76 S XAMCNT=0
77 I Y="^" Q
78 S I="" F S I=$O(^AUPNVXAM("B",I)) Q:I="" D Q:Y="^"
79 . S IEN="" F S IEN=$O(^AUPNVXAM("B",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D Q:Y="^"
80 ..S ARRAY="^AUPNVXAM(""B"",I,IEN)" S XAMCNT=XAMCNT+1 I XAMCNT#1000=2 D MON
81 ..I '$D(^AUPNVXAM(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVXAM(""B"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
82 S I="" F S I=$O(^AUPNVXAM("AD",I)) Q:I="" D Q:Y="^"
83 . S IEN="" F S IEN=$O(^AUPNVXAM("AD",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D Q:Y="^"
84 ..S ARRAY="^AUPNVXAM(""AD"",I,IEN)" S XAMCNT=XAMCNT+1 I XAMCNT#1000=2 D MON
85 ..I '$D(^AUPNVXAM(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVXAM(""AD"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
86 S I="" F S I=$O(^AUPNVXAM("C",I)) Q:I="" D Q:Y="^"
87 . S IEN="" F S IEN=$O(^AUPNVXAM("C",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D Q:Y="^"
88 ..S ARRAY="^AUPNVXAM(""C"",I,IEN)" S XAMCNT=XAMCNT+1 I XAMCNT#1000=2 D MON
89 ..I '$D(^AUPNVXAM(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVXAM(""C"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
90 S I="" F S I=$O(^AUPNVXAM("AA",I)) Q:I="" D Q:Y="^"
91 . S IEN="" F S IEN=$O(^AUPNVXAM("AA",I,IEN)) Q:IEN="" D Q:Y="^"
92 ..S IENN="" F S IENN=$O(^AUPNVXAM("AA",I,IEN,IENN)) Q:IENN="" D Q:Y="^"
93 ...S IENNN="" F S IENNN=$O(^AUPNVXAM("AA",I,IEN,IENN,IENNN)) W:IENNN#1000=22 "." Q:IENNN="" D Q:Y="^"
94 ....S ARRAY="^AUPNVXAM(""AA"",I,IEN,IENN,IENNN)" S XAMCNT=XAMCNT+1 I XAMCNT#1000=2 D MON
95 ....I '$D(^AUPNVXAM(IENNN)) W !,"Entry "_IENNN," IS NOT THERE! BAD REFERENCE IS ^AUPNVXAM(""AA"","_I_",",IEN_","_IENN_","_IENNN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
96 Q
97 ;
98MON ;--MONITOR SITUATION
99 D NOW^%DTC S NOW=% S:'$G(PAST) PAST=% I $G(PAST) D S:'$G(PAST) PAST=%
100 .I ($P(NOW,".",2)-$P(PAST,".",2))>60 D
101 ..D CAL K PAST
102 Q
103CAL ;--CALCULATE TIME LEFT
104 N IMMT,SKT,XAMT,TRTT,PEDT,HFT
105 S:'$G(IMMCNT) IMMCNT=1 S:'$G(SKCNT) SKCNT=1
106 S:'$G(XAMCNT) XAMCNT=1 S:'$G(TRTCNT) TRTCNT=1
107 S:'$G(PEDCNT) PEDCNT=1 S:'$G(HFCNT) HFCNT=1
108 ;
109 S IMMT=$P($G(^AUPNVIMM(0)),"^",4)*4 S:IMMT'>0 IMMT=1 S IMMP=(($G(IMMCNT)/IMMT)*100)
110 S SKT=$P($G(^AUPNVSK(0)),"^",4)*5 S:SKT'>0 SKT=1 S SKP=(($G(SKCNT)/SKT)*100)
111 S XAMT=$P($G(^AUPNVXAM(0)),"^",4)*4 S:XAMT'>0 XAMT=1 S XAMP=(($G(XAMCNT)/XAMT)*100)
112 S TRTT=$P($G(^AUPNVTRT(0)),"^",4)*4 S:TRTT'>0 TRTT=1 S TRTP=(($G(TRTCNT)/TRTT)*100)
113 S PEDT=$P($G(^AUPNVPED(0)),"^",4)*4 S:PEDT'>0 PEDT=1 S PEDP=(($G(PEDCNT)/PEDT)*100)
114 S HFT=$P($G(^AUPNVHF(0)),"^",4)*4 S:HFT'>0 HFT=1 S HFP=(($G(HFCNT)/HFT)*100)
115 ;
116 I IMMCNT=1 S IMMCNT=0,IMMP=0
117 I SKCNT=1 S SKCNT=0,SKP=0
118 I XAMCNT=1 S XAMCNT=0,XAMP=0
119 I TRTCNT=1 S TRTCNT=0,TRTP=0
120 I PEDCNT=1 S PEDCNT=0,PEDP=0
121 I HFCNT=1 S HFCNT=0,HFP=0
122 W !!," - - M O N I T O R AT 1 MINUTE- -" N Y,% D YX^%DTC W " "_Y
123 W !,"FILE",?20,"TOTAL",?35,"#FINISHED",?50,"%COMPLETED"
124 W !,"V IMMUNIZATION",?20,IMMT,?35,IMMCNT,?50,$E(IMMP,1,5)_"%"
125 W !,"V SKIN TEST",?20,SKT,?35,SKCNT,?50,$E(SKP,1,5)_"%"
126 W !,"V EXAM",?20,XAMT,?35,XAMCNT,?50,$E(XAMP,1,5)_"%"
127 W !,"V TREATMENT",?20,TRTT,?35,TRTCNT,?50,$E(TRTP,1,5)_"%"
128 W !,"V PATIENT ED",?20,PEDT,?35,PEDCNT,?50,$E(PEDP,1,5)_"%"
129 W !,"V HEALTH FACTOR",?20,HFT,?35,HFCNT,?50,$E(HFP,1,5)_"%"
130 Q
131 ;
132 ;
133TT ;--QUERY FOR CORRECT ENTRY
134 S DIR("A")="Should I fix this one by removing the reference ?? "
135 S DIR("B")="NO"
136 S DIR(0)="YAO" D ^DIR
137 I Y=1 D
138 .K @ARRAY
139 I Y="^" Q
140 Q
141KILL ;--AUTOMATIC
142 ;W !,"KILL "_ARRAY
143 K @ARRAY
144 Q
145PRMPT ;---PROMPT FOR PROMPTING
146 S DIR("A")="Eliminate Prompting for Confirmation? "
147 S DIR("B")="NO"
148 S DIR(0)="YAO"
149 D ^DIR
150 I Y=1 S AUTO="F"
151 K DIR
152 Q
Note: See TracBrowser for help on using the repository browser.