source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORREP01.m@ 1783

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

initial load of FOIAVistA 6/30/08 version
File size: 6.1 KB
Line 
1RORREP01 ;HOIFO/BH - REGISTRY COMPARISON REPORT ; 12/21/05 11:55am
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 ;--------------------------------------------------------------------
5 ; Registry: [VA HIV]
6 ;--------------------------------------------------------------------
7 ;
8 Q
9 ;
10BEGIN ;
11 I '$$VFILE^DILFD(158) D Q
12 . W !,"ICR v2.1 is not installed in this account!",!
13 I '$D(^XUSEC("IMRA",DUZ)) S IMRLOC="RORREP01" D ACESSERR^IMRERR,H^XUS K IMRLOC
14 ;
15 W !,?10,"####################################################"
16 W !,?10,"#",?20,"Local ICR Version Comparison Report #",?61
17 W !,?10,"####################################################"
18 ;
19 ;
20DEV D IMRDEV^IMREDIT
21 G:POP KILL
22 I '$D(IO("Q")) W @IOF D REP Q
23 I $D(IO("Q")) D G KILL
24 . S ZTRTN="REP^RORREP01",ZTDESC="Local ICR Version Comparison Report"
25 . S ZTSAVE("*")="",ZTIO=ION_";"_IOM_";"_IOSL
26 . D ^%ZTLOAD K ZTRTN,ZTDESC,ZTSAVE,ZTSK
27 . Q
28 ;
29REP ; Get Data
30 U IO
31 D EN1
32 K CNT
33 ;
34 D PRNT^RORREP02
35CLOSE D ^%ZISC K %ZIS,IOP
36 S:$D(ZTQUEUED) ZTREQ="@"
37 ;
38 ;
39KILL D ^%ZISC
40 K ^TMP("RORREP01",$J)
41 K DTOUT,VAROOT,VAERR,A,DIRUT,I,J,POP,X,X0,X1,Y,Z,D,IMRDTE,IMRFLG,IMRHED,IMRRPG,%I,DISYS,IMRPG
42 D HOME^%ZIS
43 Q
44 ;
45 ; ---------------------------------------------------------------------
46EN1 ;
47 K ^TMP("RORREP01",$J)
48 S CNT=0
49 D VTHREE
50 D VTWO
51 ;
52 D INTWO
53 D INTHREE
54 Q
55 ;
56VTHREE ; Make array of version 3 patients
57 N ICN,IDSC,NAME,RC,PAT
58 K VTHREE
59 S RC=$$PATITER^RORAPI01(.IDSC,"VA HIV")
60 I RC<0 Q
61 F S RC=$$NEXTPAT^RORAPI01(.IDSC) Q:RC'>0 D
62 . S PAT=+RC
63 . S ^TMP("RORREP01",$J,"VTHREE",PAT)=""
64 . S ICN=$$GETICN^MPIF001(PAT)
65 . Q:$L(ICN)'=9
66 . S NAME=$P(^DPT(PAT,0),"^",1)
67 . S ^TMP("RORREP01",$J,"ICN",NAME,PAT)=""
68 Q
69 ;
70 ;
71VTWO ; Make array of version 2.1 patients
72 N ENCODE,PAT,IMRIEN
73 S IMRIEN=0
74 F S IMRIEN=$O(^IMR(158,IMRIEN)) Q:'IMRIEN D
75 . S ENCODE=$P(^IMR(158,IMRIEN,0),U)
76 . I ENCODE="" D Q
77 . . S CNT=CNT+1
78 . . S ^TMP("RORREP01",$J,"ERROR","ENCODE",CNT)="Entry "_IMRIEN_" in file #158 does not have .01 field." Q
79 . S PAT=$$XOR^RORUTL03(ENCODE)
80 . I PAT=0!(PAT="") D Q
81 . . S CNT=CNT+1
82 . . S ^TMP("RORREP01",$J,"ERROR","ENCODE",CNT)="Could not decode .01 field "_ENCODE_" of file #158."
83 . ;
84 . I $D(^DPT(PAT,-9)) D Q
85 . . N NEWIEN
86 . . S NEWIEN=^DPT(PAT,-9)
87 . . I NEWIEN="" Q
88 . . I $D(^TMP("RORREP01",$J,"PROC",NEWIEN)) Q
89 . . S ^TMP("RORREP01",$J,"MERGE",NEWIEN)=ENCODE
90 . ;
91 . I $$GET1^DIQ(2,PAT,.01)="" D Q
92 . . S CNT=CNT+1
93 . . S ^TMP("RORREP01",$J,"ERROR","ENCODE",CNT)="Could not get patient name from patient file IEN "_PAT Q
94 . ;
95 . D VTWO1(PAT,ENCODE)
96 ;
97 I $D(^TMP("RORREP01",$J,"MERGE")) D
98 . N ENC,SUB4 S SUB4=0
99 . F S SUB4=$O(^TMP("RORREP01",$J,"MERGE",SUB4)) Q:SUB4="" D
100 . . S ENC=^TMP("RORREP01",$J,"MERGE",SUB4)
101 . . D VTWO1(SUB4,ENC)
102 ;
103 K ^TMP("RORREP01",$J,"PROC"),^TMP("RORREP01",$J,"MERGE")
104 Q
105 ;
106VTWO1(PAT,ENCODE) ;
107 N ICN,SSN
108 I $$GET1^DIQ(2,PAT,.01)="" D Q
109 . S CNT=CNT+1
110 . S ^TMP("RORREP01",$J,"ERROR","ENCODE",CNT)="Could not get file #2 entry for entry "_ENCODE_" of file #158."
111 ;
112 S ^TMP("RORREP01",$J,"PROC",PAT)=""
113 S ^TMP("RORREP01",$J,"VTWO",PAT)=ENCODE
114 I PAT=7202138 W ENCODE_"***"
115 S ICN=$$GETICN^MPIF001(PAT)
116 Q:$L(ICN)'=9
117 S NAME=$P(^DPT(PAT,0),"^",1)
118 S SSN=$$GET1^DIQ(2,PAT,.09),SSN=$E(SSN,6,9)
119 S ^TMP("RORREP01",$J,"ICN",NAME,PAT)=SSN
120 Q
121 ;
122INTWO ; Patients in version 2.1 and not in three or in both
123 N IEN,NAME,DATE21,RULE,SSN S IEN=0
124 F S IEN=$O(^TMP("RORREP01",$J,"VTWO",IEN)) Q:IEN="" D
125 . S NAME=$$GET1^DIQ(2,IEN,.01)
126 . S SSN=$$GET1^DIQ(2,IEN,.09),SSN=$E(SSN,6,9)
127 . S DATE21=$$DATE21(^TMP("RORREP01",$J,"VTWO",IEN))
128 . I '$D(^TMP("RORREP01",$J,"VTHREE",IEN)) D Q
129 . . S ^TMP("RORREP01",$J,"INTWO",NAME)=DATE21_"^"_SSN
130 . S RULE=$$RULE(IEN) I RULE=0 Q
131 . S ^TMP("RORREP01",$J,"INBOTH",NAME)=RULE_"^"_DATE21_"^"_SSN
132 Q
133 ;
134 ;
135INTHREE ; Patients in version 3.0 and not in two OR in both
136 N DATE21,RULE,IEN,PENDING,NAME,SSN S IEN=0
137 F S IEN=$O(^TMP("RORREP01",$J,"VTHREE",IEN)) Q:IEN="" D
138 . S NAME=$$GET1^DIQ(2,IEN,.01)
139 . S SSN=$$GET1^DIQ(2,IEN,.09),SSN=$E(SSN,6,9)
140 . I NAME="" S CNT=CNT+1,^TMP("RORREP01",$J,"ERROR","ROR",CNT)="Can't find Name from patient (#2) file IEN "_IEN_"." Q
141 . ;
142 . S RULE=$$RULE(IEN) I RULE=0 Q
143 . I '$D(^TMP("RORREP01",$J,"VTWO",IEN)) D Q
144 . . S PENDING=$$PEND(IEN)
145 . . S ^TMP("RORREP01",$J,"INTHREE",NAME)=RULE_"^"_PENDING_"^"_SSN
146 . S DATE21=$$DATE21(^TMP("RORREP01",$J,"VTWO",IEN))
147 . S ^TMP("RORREP01",$J,"INBOTH",NAME)=RULE_"^"_DATE21_"^"_SSN
148 Q
149 ;
150 ;
151DATE21(ENCODE) ; Get date added to ICR 2.1
152 N IMRCAT1,IMRCAT2,IMRCAT3,IMRCAT4,IMRNODE,IMRIEN,IMRDTE,IMRARR
153 S IMRIEN=0
154 S IMRIEN=$O(^IMR(158,"B",ENCODE,IMRIEN))
155 S IMRNODE=^IMR(158,IMRIEN,0)
156 S IMRCAT1=$P(IMRNODE,"^",36) I IMRCAT1'="" S IMRARR(IMRCAT1)=""
157 S IMRCAT2=$P(IMRNODE,"^",44) I IMRCAT2'="" S IMRARR(IMRCAT2)=""
158 S IMRCAT3=$P(IMRNODE,"^",35) I IMRCAT3'="" S IMRARR(IMRCAT3)=""
159 S IMRCAT4=$P(IMRNODE,"^",23) I IMRCAT4'="" S IMRARR(IMRCAT4)=""
160 I '$D(IMRARR) Q "No Cat. Date"
161 S IMRDTE=""
162 S IMRDTE=$O(IMRARR(IMRDTE))
163 S Y=IMRDTE D DD^%DT S IMRDTE=Y
164 Q IMRDTE
165 ;
166 ;
167PEND(IEN) ;
168 N RORIEN,PEND
169 S RORIEN="",PEND="YES"
170 S RORIEN=$O(^RORDATA(798,"KEY",IEN,2,RORIEN))
171 S RES=$P(^RORDATA(798,RORIEN,0),"^",5)
172 I RES'=4 S PEND="NO"
173 Q PEND
174 ;
175 ;
176RULE(IEN) ; Get earliest selction rule
177 N RORIEN
178 S RORIEN=""
179 S RORIEN=$O(^RORDATA(798,"KEY",IEN,2,RORIEN))
180 I 'RORIEN D Q 0
181 . S CNT=CNT+1
182 . S ^TMP("RORREP01",$J,"ERROR","ROR",CNT)="Can't find IEN of file #798 record that has a #.01 field of "_IEN_"." Q
183 ;
184 N RULE1,DATE1,SELARR,RORSRIEN,SELDATE,DATA,RULE
185 S RORSRIEN=0
186 F S RORSRIEN=$O(^RORDATA(798,RORIEN,1,RORSRIEN)) Q:'RORSRIEN D
187 . S DATA=^RORDATA(798,RORIEN,1,RORSRIEN,0)
188 . S RULE=$P(DATA,"^",1)
189 . S RULE=$$GET1^DIQ(798.2,RULE,.01,"E")
190 . S SELDATE=$P(DATA,"^",2)
191 . S SELARR(SELDATE)=RULE
192 ;
193 I '$D(SELARR) D Q 0
194 . S CNT=CNT+1
195 . N BUFF,EVID,NME
196 . S NME=$$GET1^DIQ(798,RORIEN,.01,"E")
197 . ;
198 . S EVID=$P(^RORDATA(798,RORIEN,0),U,14)
199 . I 'EVID D
200 . . S BUFF=NME_" is in ROR Local Registry file (#798) but has no selection rules."
201 . . S ^TMP("RORREP01",$J,"ERROR",IEN)=BUFF
202 . I EVID D
203 . . S ^TMP("RORREP01",$J,"ISSUE","EVID",IEN)=NME
204 S DATE1="" S DATE1=$O(SELARR(DATE1))
205 S RULE1=SELARR(DATE1)
206 S Y=DATE1 D DD^%DT S DATE1=Y
207 Q DATE1_"^"_RULE1
208 ;
209 ;
Note: See TracBrowser for help on using the repository browser.