source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORREP02.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: 6.7 KB
Line 
1RORREP02 ;HCIOFO/BH - VERSION COMPARISON REPORT (ICR) ; 7/11/03 1:22pm
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 ;--------------------------------------------------------------------
5 ; Registry: [VA HIV]
6 ;--------------------------------------------------------------------
7 ;
8PRNT ;
9 N THREEH
10 S THREEH=1
11 D NOW^%DTC S IMRDTE=%,IMRPG="0"
12 K IMRDONE
13 S Y=IMRDTE D DD^%DT S IMRDTE=Y
14 D LIST("INTWO","Patients in ICR 2.1 and not in ROR:ICR")
15 Q:$D(IMRDONE)
16 D LIST("INTHREE","Patients in ROR:ICR and not in ICR 2.1")
17 Q:$D(IMRDONE)
18 D LIST("INBOTH","Patients in ROR:ICR and in ICR 2.1")
19 Q:$D(IMRDONE)
20 D LEGEND
21 Q:$D(IMRDONE)
22 D ISSUE
23 Q:$D(IMRDONE)
24 D ERROR
25 Q:$D(IMRDONE)
26 D ICNERR
27 K IMRDONE,TMP
28 Q
29 ;
30HEDR ; Header of Report
31 S X="ICR Version Comparison Report"
32 W:$Y>0 @IOF S IMRPG=IMRPG+1
33 W IMRDTE,?72,"Page ",IMRPG,!
34 W !," ",X,!
35 W " ",IMRHED
36 W !!
37 I TYPE="INTWO" D
38 . W " Last Earliest Cat.",!
39 . W "Patient Four Date (v 2.1)",!
40 . W "------- ---- -------------",!
41 ;
42 I TYPE="INTHREE" D
43 . I THREEH D
44 . . ;
45 . . W " ** Some of these patients are in a Pending state and need to be either **"
46 . . W !," ** validated into the ICR registry or deleted via the ICR GUI. Individual **"
47 . . W !," ** patient data for pending patients will not be sent to AAC until they are **"
48 . . W !," ** validated into the registry. **"
49 . . W !!
50 . . ;
51 . . S THREEH=0
52 . W "Patient Last Earliest Sel. Location Selection",!
53 . W " Four Rule (ROR:ICR) Rule Found (ROR:ICR) Pending",!
54 . W "------- ---- -------------- -------------------- -------",!
55 .
56 ;
57 I TYPE="INBOTH" D
58 . W " Last Earliest Sel. Location Selection Earliest Cat.",!
59 . W "Patient Four Rule (ROR:ICR) Rule Found (ROR:ICR) Date (v 2.1)",!
60 . W "------- ---- -------------- --------------------- -------------",!
61 Q
62 ;
63EHEAD ;
64 S X="ICR Version Comparison Report"
65 W:$Y>0 @IOF S IMRPG=IMRPG+1
66 W !,IMRDTE,?72,"Page ",IMRPG,!
67 W !," Patients with Errors.",!!
68 W " -----------------------",!!
69 ;
70 Q
71 ;
72ENDHEAD ;
73 S X="ICR Version Comparison Report"
74 W:$Y>0 @IOF S IMRPG=IMRPG+1
75 W IMRDTE,?72,"Page ",IMRPG,!
76 W !," ",X,!!
77 ;
78 W !," Legend.",!
79 W " -------",!!
80 W " Code Description",!
81 W " ---- -----------"
82 Q
83 ;
84EVID ; Heading for patients with no selection rules but with supporting
85 ; Evidence.
86 S X="ICR Version Comparison Report"
87 W:$Y>0 @IOF S IMRPG=IMRPG+1
88 W IMRDTE,?72,"Page ",IMRPG,!
89 W !," ",X,!
90 W !,"** The following patient(s) are in the ROR Local Registry file (#798) but **"
91 W !,"** have no selection rules but do have supporting evidence for being **"
92 W !,"** manually added to the Registry. Please consider adding HIV disease (042) **"
93 W !,"** to the patient's problem list. **",!
94 Q
95 ;
96ICNHEAD ;
97 S X="ICR Version Comparison Report"
98 W:$Y>0 @IOF S IMRPG=IMRPG+1
99 W IMRDTE,?72,"Page ",IMRPG,!
100 W !," ",X,!!
101 ;
102 W "** The following Patients have local ICN's (Intergration Control Numbers) **"
103 W !,"** and will not have data extracted and transmitted to the national ICR **"
104 W !,"** database. Since your facility's VERA reimbursement is calculated from **"
105 W !,"** the National database, it is important that these patient records be **"
106 W !,"** updated by the sites IRM with National ICNs. **"
107 W !!
108 W " Name Last Four",!
109 W " ---- ---------"
110 Q
111 ;
112 ;
113LIST(TYPE,IMRHED) ; List patients missing data values
114 D HEDR
115 I '$D(^TMP("RORREP01",$J,TYPE)) D Q
116 . W !!,"No patients found." D PRTC Q:$D(IMRDONE)
117 N NAME,DTE2,NEWNAME,TWOLOC,TWODATE,LOC3,LOC4,DATE3,BOTHLOC,BOTHDTE,DTE3,DATA,SSN
118 N RORTOTAL
119 Q:$D(IMRDONE)
120 S (NAME,RORTOTAL)=0
121 F S NAME=$O(^TMP("RORREP01",$J,TYPE,NAME)) Q:NAME="" D Q:$D(IMRDONE)
122 . I ($Y+4>IOSL) D PRTC Q:$D(IMRDONE) D HEDR
123 . S DATA=^TMP("RORREP01",$J,TYPE,NAME)
124 . S NEWNAME=$E(NAME_" ",1,27)
125 . I TYPE="INTWO" D
126 . . S SSN=$P(DATA,"^",2)
127 . . S DATA=$P(DATA,"^",1)
128 . . W !,NEWNAME_SSN_" "_DATA
129 . . S RORTOTAL=RORTOTAL+1
130 . ;
131 . I TYPE="INTHREE" D
132 . . S SSN=$P(DATA,"^",4)
133 . . S DATE3=$P(DATA,"^",1),DATE3=$E(DATE3_" ",1,18)
134 . . S LOC3=$P(DATA,"^",2),LOC3=$E(LOC3_" ",1,25)
135 . . S LOC4=$P(DATA,"^",3)
136 . . W !,NEWNAME_SSN_" "_DATE3_LOC3_LOC4
137 . . S RORTOTAL=RORTOTAL+1
138 . ;
139 . I TYPE="INBOTH" D
140 . . S SSN=$P(DATA,"^",4)
141 . . S NEWNAME=$E(NEWNAME,1,25)
142 . . S BOTHDTE=$P(DATA,"^",1),BOTHDTE=$E(BOTHDTE_" ",1,15)
143 . . S BOTHLOC=$P(DATA,"^",2),BOTHLOC=$E(BOTHLOC_" ",1,22)
144 . . S DTE2=$P(DATA,"^",3)
145 . . W !,NEWNAME_SSN_" "_BOTHDTE_BOTHLOC_DTE2
146 . . S RORTOTAL=RORTOTAL+1
147 ;
148 I ($Y+4>IOSL) D PRTC Q:$D(IMRDONE) D HEDR
149 W !,"Total Patients: "_RORTOTAL
150 ;
151 D PRTC
152 Q
153 ;
154 ;
155LEGEND ;
156 D ENDHEAD
157 W !
158 W !," VA HIV 2.1 CONVERSION Converted from ICR 2.1"
159 W !," VA HIV LAB ICR Lab Results"
160 W !," VA HIV PROBLEM ICR ICD-9 in the Problem List"
161 W !," VA HIV PTF ICR ICD-9 in the Inpatient File (PTF)"
162 W !," VA HIV VPOV ICR ICD-9 in the Outpatient File (V POV)"
163 D PRTC
164 Q
165 ;
166ICNERR ;
167 I '$D(^TMP("RORREP01",$J,"ICN")) Q
168 D ICNHEAD
169 N DFN,NAME,SSN
170 S NAME=""
171 F S NAME=$O(^TMP("RORREP01",$J,"ICN",NAME)) Q:NAME="" D
172 . S DFN=""
173 . F S DFN=$O(^TMP("RORREP01",$J,"ICN",NAME,DFN)) Q:'DFN D
174 . . I ($Y+4>IOSL) D PRTC Q:$D(IMRDONE) D ICNHEAD
175 . . S SSN=^TMP("RORREP01",$J,"ICN",NAME,DFN)
176 . . W !," ",$E(NAME_" ",1,27)_SSN
177 Q
178 ;
179ISSUE ;
180 I '$D(^TMP("RORREP01",$J,"ISSUE","EVID")) Q
181 D EVID
182 N EIEN,NME S EIEN=0
183 F S EIEN=$O(^TMP("RORREP01",$J,"ISSUE","EVID",EIEN)) Q:'EIEN D
184 . I ($Y+4>IOSL) D PRTC Q:$D(IMRDONE) D EVID
185 . S NME=^TMP("RORREP01",$J,"ISSUE","EVID",EIEN)
186 . W !,NME
187 D PRTC
188 Q
189 ;
190ERROR ;
191 I '$D(^TMP("RORREP01",$J,"ERROR")) Q
192 D EHEAD
193 N CNT,EIEN,BUF,BUF1,BUFP S EIEN=0
194 F S EIEN=$O(^TMP("RORREP01",$J,"ERROR",EIEN)) Q:'EIEN D
195 . I ($Y+4>IOSL) D PRTC Q:$D(IMRDONE) D EHEAD
196 . S BUFP=^TMP("RORREP01",$J,"ERROR",EIEN)
197 . S BUF=$E(BUFP,1,78),BUF1=$E(BUFP,79,150)
198 . W BUF I BUF1'="" W "-"
199 . W !
200 . W BUF1,!
201 . I BUF1'="" W !
202 ;
203 F TMP="ROR","ENCODE" D
204 . S CNT=0
205 . F S CNT=$O(^TMP("RORREP01",$J,"ERROR",TMP,CNT)) Q:'CNT D
206 . . I ($Y+4>IOSL) D PRTC Q:$D(IMRDONE) D EHEAD
207 . . S BUFP=^TMP("RORREP01",$J,"ERROR",TMP,CNT)
208 . . S BUF=$E(BUFP,1,78),BUF1=$E(BUFP,79,150)
209 . . W BUF I BUF1'="" W "-"
210 . . W !
211 . . W BUF1,!
212 . . I BUF1'="" W !
213 D PRTC
214 Q
215 ;
216 ;
217PRTC ;press return to continue prompt
218 Q:$E(IOST,1,2)'="C-"!($D(IO("S")))
219 K DIR W ! S DIR(0)="E" D ^DIR K DIR I 'Y S IMRDONE=1
220 Q
Note: See TracBrowser for help on using the repository browser.