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

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

initial load of FOIAVistA 6/30/08 version
File size: 8.2 KB
Line 
1PXQUTL3A ;ISL/JVS CLEAN OUT BAD XREF #2 ;4/16/97 14:30
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**29**;Aug 12, 1996
3 ;
4 ;
5 Q
6 ;
7V ;--------------VISIT FILE---------------------------------
8 W !!,"Checking the VISIT FILE #9000010 (VISITS)",!
9 S VSTCNT=0
10 I Y="^" Q
11 D Q
12 Q
13AA ;-----------------AA-LEVEL 3------------------------------
14 S VSTXCNT=0,XREF="^AUPNVSIT('AA',"
15 W !!,"Checking the ^AUPNVSIT(""AA"") X-REF",!
16 S I="" F S I=$O(^AUPNVSIT("AA",I)) Q:I="" D G:Y="^" EXIT
17 . S IEN="" F S IEN=$O(^AUPNVSIT("AA",I,IEN)) Q:IEN="" D
18 ..S IENN="" F S IENN=$O(^AUPNVSIT("AA",I,IEN,IENN)) W:IENN#1000=22 "." Q:IENN="" D
19 ...S ARRAY="^AUPNVSIT(""AA"",I,IEN,IENN)" S VSTCNT=VSTCNT+1,VSTXCNT=VSTXCNT+1 I VSTCNT#1000=2 D MON^PXQUTL3
20 ...I '$D(^AUPNVSIT(IENN)) W !,"Entry "_IENN," IS NOT THERE! BAD REFERENCE IS ^AUPNVPOV(""AA"","_I_",",IEN_","_IENN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
21 ;
22 Q
23AD ;-----------------AD-LEVEL 2------------------------------
24 S VSTXCNT=0,XREF="^AUPNVSIT('AD',"
25 W !!,"Checking the ^AUPNVSIT(""AD"") X-REF",!
26 S I="" F S I=$O(^AUPNVSIT("AD",I)) Q:I="" D G:Y="^" EXIT
27 . S IEN="" F S IEN=$O(^AUPNVSIT("AD",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D
28 ..S ARRAY="^AUPNVSIT(""AD"",I,IEN)" S VSTCNT=VSTCNT+1,VSTXCNT=VSTXCNT+1 I VSTCNT#1000=2 D MON^PXQUTL3
29 ..I '$D(^AUPNVSIT(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVSIT(""AD"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
30 ;
31 Q
32ADEL ;-----------------ADEL-LEVEL 2------------------------------
33 S VSTXCNT=0,XREF="^AUPNVSIT('ADEL',"
34 W !!,"Checking the ^AUPNVSIT(""ADEL"") X-REF",!
35 S I="" F S I=$O(^AUPNVSIT("ADEL",I)) Q:I="" D G:Y="^" EXIT
36 . S IEN="" F S IEN=$O(^AUPNVSIT("ADEL",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D
37 ..S ARRAY="^AUPNVSIT(""ADEL"",I,IEN)" S VSTCNT=VSTCNT+1,VSTXCNT=VSTXCNT+1 I VSTCNT#1000=2 D MON^PXQUTL3
38 ..I '$D(^AUPNVSIT(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVSIT(""ADEL"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
39 ;
40 Q
41AET ;-----------------AET-LEVEL 5------------------------------
42 S VSTXCNT=0,XREF="^AUPNVSIT('AET',"
43 W !!,"Checking the ^AUPNVSIT(""AET"") X-REF",!
44 S I="" F S I=$O(^AUPNVSIT("AET",I)) Q:I="" D G:Y="^" EXIT
45 . S IEN="" F S IEN=$O(^AUPNVSIT("AET",I,IEN)) Q:IEN="" D
46 ..S IENN="" F S IENN=$O(^AUPNVSIT("AET",I,IEN,IENN)) Q:IENN="" D
47 ...S IENNN="" F S IENNN=$O(^AUPNVSIT("AET",I,IEN,IENN,IENNN)) Q:IENNN="" D
48 ....S IENNNN="" F S IENNNN=$O(^AUPNVSIT("AET",I,IEN,IENN,IENNN,IENNNN)) W:IENNNN#1000=22 "." Q:IENNNN="" D
49 .....S ARRAY="^AUPNVSIT(""AET"",I,IEN,IENN,IENNN,IENNNN)" S VSTCNT=VSTCNT+1,VSTXCNT=VSTXCNT+1 I VSTCNT#1000=2 D MON^PXQUTL3
50 .....I '$D(^AUPNVSIT(IENNNN)) W !,"Entry "_IENNNN," IS NOT THERE! BAD REFERENCE IS ^AUPNVSIT(""AET"","_I_",",IEN_","_IENN_","_IENNN_","_IENNNN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
51 ;
52 Q
53AHL ;-----------------AHL-LEVEL 3------------------------------
54 S VSTXCNT=0,XREF="^AUPNVSIT('AHL',"
55 W !!,"Checking the ^AUPNVSIT(""AHL"") X-REF",!
56 S I="" F S I=$O(^AUPNVSIT("AHL",I)) Q:I="" D G:Y="^" EXIT
57 . S IEN="" F S IEN=$O(^AUPNVSIT("AHL",I,IEN)) Q:IEN="" D
58 ..S IENN="" F S IENN=$O(^AUPNVSIT("AHL",I,IEN,IENN)) W:IENN#1000=22 "." Q:IENN="" D
59 ...S ARRAY="^AUPNVSIT(""AHL"",I,IEN,IENN)" S VSTCNT=VSTCNT+1,VSTXCNT=VSTXCNT+1 I VSTCNT#1000=2 D MON^PXQUTL3
60 ...I '$D(^AUPNVSIT(IENN)) W !,"Entry "_IENN," IS NOT THERE! BAD REFERENCE IS ^AUPNVPOV(""AHL"","_I_",",IEN_","_IENN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
61 ;
62 Q
63B ;-----------------B-LEVEL 2------------------------------
64 S VSTXCNT=0,XREF="^AUPNVSIT('B',"
65 W !!,"Checking the ^AUPNVSIT(""B"") X-REF",!
66 S I="" F S I=$O(^AUPNVSIT("B",I)) Q:I="" D G:Y="^" EXIT
67 . S IEN="" F S IEN=$O(^AUPNVSIT("B",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D
68 ..S ARRAY="^AUPNVSIT(""B"",I,IEN)" S VSTCNT=VSTCNT+1,VSTXCNT=VSTXCNT+1 I VSTCNT#1000=2 D MON^PXQUTL3
69 ..I '$D(^AUPNVSIT(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVSIT(""B"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
70 ;
71 Q
72C ;-----------------C-LEVEL 2------------------------------
73 S VSTXCNT=0,XREF="^AUPNVSIT('C',"
74 W !!,"Checking the ^AUPNVSIT(""C"") X-REF",!
75 S I="" F S I=$O(^AUPNVSIT("C",I)) Q:I="" D G:Y="^" EXIT
76 . S IEN="" F S IEN=$O(^AUPNVSIT("C",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D
77 ..S ARRAY="^AUPNVSIT(""C"",I,IEN)" S VSTCNT=VSTCNT+1,VSTXCNT=VSTXCNT+1 I VSTCNT#1000=2 D MON^PXQUTL3
78 ..I '$D(^AUPNVSIT(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVSIT(""C"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
79 ;
80 Q
81VID ;-----------------VID-LEVEL 2------------------------------
82 S VSTXCNT=0,XREF="^AUPNVSIT('VID',"
83 W !!,"Checking the ^AUPNVSIT(""VID"") X-REF",!
84 S I="" F S I=$O(^AUPNVSIT("VID",I)) Q:I="" D G:Y="^" EXIT
85 . S IEN="" F S IEN=$O(^AUPNVSIT("VID",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D
86 ..S ARRAY="^AUPNVSIT(""VID"",I,IEN)" S VSTCNT=VSTCNT+1,VSTXCNT=VSTXCNT+1 I VSTCNT#1000=2 D MON^PXQUTL3
87 ..I '$D(^AUPNVSIT(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVSIT(""VID"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
88 ;
89 Q
90AAH ;-----------------AAH-LEVEL 3------------------------------
91 S VSTXCNT=0,XREF="^AUPNVSIT('AAH',"
92 W !!,"Checking the ^AUPNVSIT(""AAH"") X-REF",!
93 S I="" F S I=$O(^AUPNVSIT("AAH",I)) Q:I="" D G:Y="^" EXIT
94 . S IEN="" F S IEN=$O(^AUPNVSIT("AAH",I,IEN)) Q:IEN="" D
95 ..S IENN="" F S IENN=$O(^AUPNVSIT("AAH",I,IEN,IENN)) W:IENN#1000=22 "." Q:IENN="" D
96 ...S ARRAY="^AUPNVSIT(""AAH"",I,IEN,IENN)" S VSTCNT=VSTCNT+1,VSTXCNT=VSTXCNT+1 I VSTCNT#1000=2 D MON^PXQUTL3
97 ...I '$D(^AUPNVSIT(IENN)) W !,"Entry "_IENN," IS NOT THERE! BAD REFERENCE IS ^AUPNVPOV(""AAH"","_I_",",IEN_","_IENN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
98 Q
99 ;
100 ;-------------------------------------------------------
101S ;++--SCREEN FOR POSSIBLE BROKEN X REFERENCES
102 ;--V PROVIDER FILE
103 S (VSTCNT,CPTCNT,PRVCNT,POVCNT)=0
104 W !!,"Screening the V provider file",!
105 S I="" F S I=$O(^AUPNVPRV("B",I)) Q:I="" D G:Y="^" EXIT
106 . S IEN="" F S IEN=$O(^AUPNVPRV("B",I,IEN)) W:IEN#10000=22 "." Q:IEN="" D
107 ..S ARRAY="^AUPNVPRV(""B"",I,IEN)" S PRVCNT=PRVCNT+1 I PRVCNT#1000=2 D MON^PXQUTL3
108 ..I '$D(^AUPNVPRV(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVPRV(""B"","_I_",",IEN_")"
109 ;
110 ;--V POV FILE (DIAGNOSIS)
111 W !!,"Screening the V POV file (IDAGNOSIS)",!
112 S I="" F S I=$O(^AUPNVPOV("B",I)) Q:I="" D G:Y="^" EXIT
113 . S IEN="" F S IEN=$O(^AUPNVPOV("B",I,IEN)) W:IEN#10000=22 "." Q:IEN="" D
114 ..S ARRAY="^AUPNVPOV(""B"",I,IEN)" S POVCNT=POVCNT+1 I POVCNT#1000=2 D MON^PXQUTL3
115 ..I '$D(^AUPNVPOV(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVPOV(""B"","_I_",",IEN_")"
116 ;--V CPT FILE (PROCEDURES)
117 W !!,"Screening the V CPT file (PROCEDURES)",!
118 S I="" F S I=$O(^AUPNVCPT("B",I)) Q:I="" D G:Y="^" EXIT
119 . S IEN="" F S IEN=$O(^AUPNVCPT("B",I,IEN)) W:IEN#10000=22 "." Q:IEN="" D
120 ..S ARRAY="^AUPNVCPT(""B"",I,IEN)" S CPTCNT=CPTCNT+1 I CPTCNT#1000=2 D MON^PXQUTL3
121 ..I '$D(^AUPNVCPT(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVCPT(""B"","_I_",",IEN_")"
122 ;--VISIT FILE
123 W !!,"Screening the VISIT file",!
124 S I="" F S I=$O(^AUPNVSIT("B",I)) Q:I="" D G:Y="^" EXIT
125 . S IEN="" F S IEN=$O(^AUPNVSIT("B",I,IEN)) W:IEN#10000=22 "." Q:IEN="" D
126 ..S ARRAY="^AUPNVSIT(""B"",I,IEN)" S VSTCNT=VSTCNT+1 I VSTCNT#1000=2 D MON^PXQUTL3
127 ..I '$D(^AUPNVSIT(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVSIT(""B"","_I_",",IEN_")"
128 Q
129 ;
130TT ;--QUERY FOR CORRECT ENTRY
131 S DIR("A")="Should I fix this one by removing the reference ??"
132 S DIR("B")="NO"
133 S DIR(0)="YAO" D ^DIR
134 I Y=1 D
135 .K @ARRAY
136 I Y="^" Q
137 K DIR
138 Q
139KILL ;--AUTOMATIC
140 ;W !,"KILL "_ARRAY
141 K @ARRAY
142 Q
143EXIT K DIR,DA,DIK
144 Q
145Q ;---PROMPT FOR WHICH X-REF
146 I AUTO="F",AUTOO="F" D AA,AAH,AD,ADEL,AET,AHL,B,C,VID Q
147 S DIR(0)="SOM^AA:AA X-REF;AAH:AAH X-REF;AD:AD X-REF;ADEL:ADEL X-REF;AET:AET X-REF;AHL:AHL X-REF;B:B X-REF;C:C X-REF;VID:VID X-REF;ALL:ALL X-REFERENCES"
148 S DIR("A")="Select a VISIT Cross-reference: "
149 S DIR("B")="B"
150 D ^DIR
151 I Y="AA" D AA G Q
152 I Y="AAH" D AAH G Q
153 I Y="AD" D AD G Q
154 I Y="ADEL" D ADEL G Q
155 I Y="AET" D AET G Q
156 I Y="AHL" D AHL G Q
157 I Y="B" D B G Q
158 I Y="C" D C G Q
159 I Y="VID" D VID G Q
160 I Y="ALL" D
161 .D AA I Y="^" Q
162 .D AAH I Y="^" Q
163 .D AD I Y="^" Q
164 .D ADEL I Y="^" Q
165 .D AET I Y="^" Q
166 .D AHL I Y="^" Q
167 .D B I Y="^" Q
168 .D C I Y="^" Q
169 .D VID Q
170 K DIR
171 Q
Note: See TracBrowser for help on using the repository browser.