source: WorldVistAEHR/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXQUTL3.m@ 1351

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

initial load of WorldVistAEHR
File size: 8.0 KB
Line 
1PXQUTL3 ;ISL/JVS CLEAN OUT BAD CROSSREFERENCES ;4/16/97 14:30
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**29,131**;Aug 12, 1996
3 ;
4T ;
5 ;
6 W !!!," NOTES CONCERNING THIS OPTION"
7 W !
8 W !," These options will check for broken cross-references in all of"
9 W !," the PCE visit files. It is interactive."
10 W !," 'S' will go through ONLY the 'B' X-REF of each file looking for problems."
11 W !," To EXIT the program, you can enter an '^' at any prompt."
12 W !," At about 1 minute intervals a message will come up telling you"
13 W !," how much work has already been done."
14 W !
15 S Y=""
16 S DIR(0)="S^S:Screen of 4 'MAIN' files;P:Provider V PROVIDER FILE;"
17 S DIR(0)=DIR(0)_"D:Diagnosis V POV FILE;C:CPT V CPT FILE;"
18 S DIR(0)=DIR(0)_"V:Visit VISIT FILE;O:Other 6 V Files;"
19 S DIR(0)=DIR(0)_"R:Repair 4 'MAIN' V Files without prompting (automatic);"
20 S DIR(0)=DIR(0)_"F:Fix ALL files without prompting (automatic)"
21 S DIR("A")="Which file do you need to fix "
22 S DIR("B")="P"
23 D ^DIR
24 N X,IEN,IENN,IENNN,I,ARRAY,PAST,NOW,%,PRVCNT,PRVP,POVCNT,POVP
25 N CPTCNT,CNTP,VSTCNT,VSTP,AUTO,XREF,VSTXCNT,AUTOO
26 S (AUTO,AUTOO)="",XREF="NONE",VSTXCNT=0
27 I Y="P" D PRMPT,P G T
28 I Y="D" D PRMPT,D G T
29 I Y="C" D PRMPT,C G T
30 I Y="O" D INF,PRMPT,O^PXQUTL3B G T
31 I Y="V" D PRMPT,V^PXQUTL3A G T
32 I Y="R" D PRMPT S:AUTO="F" AUTOO="F" D P,D,C,V^PXQUTL3A G T
33 I Y="S" D S^PXQUTL3A G T
34 I Y="F" S (AUTO,AUTOO)="F" D P,D,C,V^PXQUTL3A,O^PXQUTL3B G T
35 I Y="^" G EXIT
36 Q
37 ;
38 ;
39 ;
40P ;---CHECK FOR BROKEN CROSSREFERENCES
41 S PRVCNT=0
42 I Y="^" Q
43 W !,"Checking the V PROVIDER FILE #9000010.06",!
44 S I="" F S I=$O(^AUPNVPRV("B",I)) Q:I="" D G:Y="^" EXIT
45 . S IEN="" F S IEN=$O(^AUPNVPRV("B",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D
46 ..S ARRAY="^AUPNVPRV(""B"",I,IEN)" S PRVCNT=PRVCNT+1 I PRVCNT#1000=2 D MON
47 ..I '$D(^AUPNVPRV(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVPRV(""B"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
48 S I="" F S I=$O(^AUPNVPRV("AD",I)) Q:I="" D G:Y="^" EXIT
49 . S IEN="" F S IEN=$O(^AUPNVPRV("AD",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D
50 ..S ARRAY="^AUPNVPRV(""AD"",I,IEN)" S PRVCNT=PRVCNT+1 I PRVCNT#1000=2 D MON
51 ..I '$D(^AUPNVPRV(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVPRV(""AD"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
52 S I="" F S I=$O(^AUPNVPRV("C",I)) Q:I="" D G:Y="^" EXIT
53 . S IEN="" F S IEN=$O(^AUPNVPRV("C",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D
54 ..S ARRAY="^AUPNVPRV(""C"",I,IEN)" S PRVCNT=PRVCNT+1 I PRVCNT#1000=2 D MON
55 ..I '$D(^AUPNVPRV(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVPRV(""C"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
56 Q
57 ;
58 ;
59 ;
60 ;
61D W !!,"Checking the V POV FILE #9000010.07 (PROCEDURES)",!
62 S POVCNT=0
63 I Y="^" Q
64 S I="" F S I=$O(^AUPNVPOV("B",I)) Q:I="" D G:Y="^" EXIT
65 . S IEN="" F S IEN=$O(^AUPNVPOV("B",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D
66 ..S ARRAY="^AUPNVPOV(""B"",I,IEN)" S POVCNT=POVCNT+1 I POVCNT#1000=2 D MON
67 ..I '$D(^AUPNVPOV(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVPOV(""B"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
68 S I="" F S I=$O(^AUPNVPOV("AD",I)) Q:I="" D G:Y="^" EXIT
69 . S IEN="" F S IEN=$O(^AUPNVPOV("AD",I,IEN)) Q:IEN="" D
70 ..S ARRAY="^AUPNVPOV(""AD"",I,IEN)" S POVCNT=POVCNT+1 I POVCNT#1000=2 D MON
71 ..I '$D(^AUPNVPOV(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVPOV(""AD"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
72 S I="" F S I=$O(^AUPNVPOV("C",I)) Q:I="" D G:Y="^" EXIT
73 . S IEN="" F S IEN=$O(^AUPNVPOV("C",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D
74 ..S ARRAY="^AUPNVPOV(""C"",I,IEN)" S POVCNT=POVCNT+1 I POVCNT#1000=2 D MON
75 ..I '$D(^AUPNVPOV(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVPOV(""C"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
76 S I="" F S I=$O(^AUPNVPOV("AA",I)) Q:I="" D G:Y="^" EXIT
77 . S IEN="" F S IEN=$O(^AUPNVPOV("AA",I,IEN)) Q:IEN="" D
78 ..S IENN="" F S IENN=$O(^AUPNVPOV("AA",I,IEN,IENN)) W:IENN#1000=22 "." Q:IENN="" D
79 ...S ARRAY="^AUPNVPOV(""AA"",I,IEN,IENN)" S POVCNT=POVCNT+1 I POVCNT#1000=2 D MON
80 ...I '$D(^AUPNVPOV(IENN)) W !,"Entry "_IENN," IS NOT THERE! BAD REFERENCE IS ^AUPNVPOV(""AA"","_I_",",IEN_","_IENN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
81 Q
82 ;
83 ;
84C W !!,"Checking the V CPT FILE #9000010.18 (PROCEDURES)",!
85 S CPTCNT=0
86 I Y="^" Q
87 S I="" F S I=$O(^AUPNVCPT("B",I)) Q:I="" D G:Y="^" EXIT
88 . S IEN="" F S IEN=$O(^AUPNVCPT("B",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D
89 ..S ARRAY="^AUPNVCPT(""B"",I,IEN)" S CPTCNT=CPTCNT+1 I CPTCNT#1000=2 D MON
90 ..I '$D(^AUPNVCPT(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVCPT(""B"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
91 S I="" F S I=$O(^AUPNVCPT("AD",I)) Q:I="" D G:Y="^" EXIT
92 . S IEN="" F S IEN=$O(^AUPNVCPT("AD",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D
93 ..S ARRAY="^AUPNVCPT(""AD"",I,IEN)" S CPTCNT=CPTCNT+1 I CPTCNT#1000=2 D MON
94 ..I '$D(^AUPNVCPT(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVCPT(""AD"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
95 S I="" F S I=$O(^AUPNVCPT("C",I)) Q:I="" D G:Y="^" EXIT
96 . S IEN="" F S IEN=$O(^AUPNVCPT("C",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D
97 ..S ARRAY="^AUPNVCPT(""C"",I,IEN)" S CPTCNT=CPTCNT+1 I CPTCNT#1000=2 D MON
98 ..I '$D(^AUPNVCPT(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVCPT(""C"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
99 S I="" F S I=$O(^AUPNVCPT("AA",I)) Q:I="" D G:Y="^" EXIT
100 . S IEN="" F S IEN=$O(^AUPNVCPT("AA",I,IEN)) Q:IEN="" D
101 ..S IENN="" F S IENN=$O(^AUPNVCPT("AA",I,IEN,IENN)) Q:IENN="" D
102 ...S IENNN="" F S IENNN=$O(^AUPNVCPT("AA",I,IEN,IENN,IENNN)) W:IENNN#1000=22 "." Q:IENNN="" D
103 ....S ARRAY="^AUPNVCPT(""AA"",I,IEN,IENN,IENNN)" S CPTCNT=CPTCNT+1 I CPTCNT#1000=2 D MON
104 ....I '$D(^AUPNVCPT(IENNN)) W !,"Entry "_IENNN," IS NOT THERE! BAD REFERENCE IS ^AUPNVCPT(""AA"","_I_",",IEN_","_IENN_","_IENNN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
105 Q
106 ;
107 ;
108TT ;--QUERY FOR CORRECT ENTRY
109 S DIR("A")="Should I fix this one by removing the reference ?? "
110 S DIR("B")="NO"
111 S DIR(0)="YAO" D ^DIR
112 I Y=1 D
113 .K @ARRAY
114 I Y="^" Q
115 Q
116KILL ;--AUTOMATIC
117 ;W !,"KILL "_ARRAY
118 K @ARRAY
119 Q
120EXIT K DIR,DA,DIK
121 Q
122MON ;--MONITOR SITUATION
123 D NOW^%DTC S NOW=% S:'$G(PAST) PAST=% I $G(PAST) D S:'$G(PAST) PAST=%
124 .I $P(NOW,".",1)'=$P(PAST,".",1) K PAST Q
125 .I ($P(NOW,".",2)-$P(PAST,".",2))>60 D
126 ..D CAL K PAST
127 Q
128CAL ;--CALCULATE TIME LEFT
129 N PRVT,POVT,CPTT,VSTT
130 N CPTP,VSTX,VSTXP ;PX*1.0*131 (to satisfy ^XINDEX)
131 S:'$G(PRVCNT) PRVCNT=1 S:'$G(POVCNT) POVCNT=1
132 S:'$G(CPTCNT) CPTCNT=1 S:'$G(VSTCNT) VSTCNT=1
133 S PRVT=$P($G(^AUPNVPRV(0)),"^",4)*3,PRVP=(($G(PRVCNT)/PRVT)*100)
134 S POVT=$P($G(^AUPNVPOV(0)),"^",4)*4,POVP=(($G(POVCNT)/POVT)*100)
135 S CPTT=$P($G(^AUPNVCPT(0)),"^",4)*4,CPTP=(($G(CPTCNT)/CPTT)*100)
136 S VSTT=$P($G(^AUPNVSIT(0)),"^",4)*9,VSTP=(($G(VSTCNT)/VSTT)*100)
137 S VSTX=$P($G(^AUPNVSIT(0)),"^",4),VSTXP=(($G(VSTXCNT)/VSTX)*100)
138 I PRVCNT=1 S PRVCNT=0,PRVP=0
139 I POVCNT=1 S POVCNT=0,POVP=0
140 I CPTCNT=1 S CPTCNT=0,CPTP=0
141 I VSTCNT=1 S VSTCNT=0,VSTP=0
142 W !!," - - M O N I T O R AT 1 MINUTE- -" N Y D YX^%DTC W " "_Y
143 W !,"FILE",?20,"TOTAL",?35,"#FINISHED",?50,"%COMPLETED"
144 W !,"V PROVIDER",?20,PRVT,?35,PRVCNT,?50,$E(PRVP,1,5)_"%"
145 W !,"V POV",?20,POVT,?35,POVCNT,?50,$E(POVP,1,5)_"%"
146 W !,"V CPT",?20,CPTT,?35,CPTCNT,?50,$E(CPTP,1,5)_"%"
147 W !,"VISIT",?20,VSTT,?35,VSTCNT,?50,$E(VSTP,1,5)_"%"
148 W !,XREF,?20,VSTX,?35,VSTXCNT,?50,$E(VSTXP,1,5)_"%"
149 Q
150PRMPT ;---PROMPT FOR PROMPTING
151 S DIR("?",1)="By saying YES to this prompt, you will eliminate being asked"
152 S DIR("?")="over and over again, 'Should I fix this one by removing the reference ??'"
153 S DIR("A")="Eliminate Prompting for Confirmation? "
154 S DIR("B")="NO"
155 S DIR(0)="YAO"
156 D ^DIR
157 I Y=1 S AUTO="F"
158 K DIR
159 Q
160INF ;--LIST OF OTHER 6 V FILES
161 W !!,"The 'OTHER' 6 V-files are:"
162 W !,"V IMMUNIZATION file#9000010.11"
163 W !,"V SKIN TEST file#9000010.12"
164 W !,"V EXAM file#9000010.13"
165 W !,"V TREATMENT file#9000010.15"
166 W !,"V PATIENT ED file#9000010.16"
167 W !,"V HEALTH FACTOR file#9000010.23",!
168 Q
Note: See TracBrowser for help on using the repository browser.