source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORUTL17.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: 7.8 KB
Line 
1RORUTL17 ;HCIOFO/SG - REGISTRY INFORMATION UTILITIES ; 8/25/05 1:44pm
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 Q
5 ;
6 ;***** ADDS THE PENDING PATIENT TO THE LIST
7 ;
8 ; REGIEN Registry IEN
9 ; IEN IEN of the registry record
10 ; PATIEN Patient IEN (DFN)
11 ;
12 ; Return Values:
13 ; <0 Error code
14 ; 0 Ok
15 ;
16ADDPP(REGIEN,IEN,PATIEN) ;
17 N BUF,I,NODE,IEN1,TMP,VA,VADM
18 D VADEM^RORUTL05(PATIEN)
19 S @ROR8DST@("PPL",PATIEN)=IEN_U_$$XOR^RORUTL03($P($G(VADM(2)),U))
20 ;--- Dates of selection rules
21 S NODE=$$ROOT^DILFD(798.01,","_IEN_",",1),BUF=""
22 S IEN1=0
23 F S IEN1=$O(@NODE@(IEN1)) Q:IEN1'>0 D
24 . S TMP=$G(@NODE@(IEN1,0)),I=+$G(RORSRL(+TMP))
25 . S:I>0 $P(BUF,U,I)=$P(TMP,U,2)
26 S @ROR8DST@("PPL",PATIEN,1)=BUF
27 Q 0
28 ;
29 ;***** FORMATS THE DATE
30DATE(DATE) ;
31 Q $S(DATE>1:$$FMTE^XLFDT(DATE\1,"5Z"),1:"")
32 ;
33 ;***** LOADS THE LIST OF SELECTION RULES
34 ;
35 ; REGIEN Registry IEN
36 ; .SRLST Reference to a local variable for the
37 ; list of selection rules
38 ;
39 ; Return Values:
40 ; <0 Error code
41 ; 0 Ok
42 ;
43LOADSRL(REGIEN,SRLST) ;
44 N IEN,NAME,NODE
45 S NODE=$$ROOT^DILFD(798.2,,1)
46 S IEN=0
47 F S IEN=$O(@NODE@(IEN)) Q:IEN'>0 D
48 . S NAME=$P($G(@NODE@(IEN,0)),U) Q:NAME=""
49 . I NAME?1"VA"1.E1"LAB".E S SRLST(IEN)="1^LAB" Q
50 . I NAME?1"VA"1.E1"PROBLEM".E S SRLST(IEN)="2^PROBLEM" Q
51 . I NAME?1"VA"1.E1"PTF".E S SRLST(IEN)="3^PTF" Q
52 . I NAME?1"VA"1.E1"VPOV".E S SRLST(IEN)="4^VISIT" Q
53 . I NAME?1"VA"1.E1"VISIT".E S SRLST(IEN)="4^VISIT" Q
54 Q 0
55 ;
56 ;***** COUNTS PATIENTS WITH ERRORS
57 ;
58 ; REGIEN Registry IEN
59 ;
60 ; Return Values:
61 ; <0 Error code
62 ; 0 Ok
63 ; >0 Number of patients with errors
64 ;
65PTERR(REGIEN,SPI) ;
66 N CNT,IEN,NODE,RC,TMP
67 W:SPI !,"Counting patients with errors",!
68 S NODE=$$ROOT^DILFD(798.3,,1),(CNT,RC)=0
69 S IEN=0
70 F S IEN=$O(@NODE@(IEN)) Q:IEN'>0 D
71 . W:SPI "."
72 . S:$D(@NODE@(IEN,1,"B",REGIEN)) CNT=CNT+1
73 Q $S(RC<0:RC,1:CNT)
74 ;
75 ;***** GATHERS THE INFORMATION ABOUT THE REGISTRY
76 ;
77 ; REGIEN Registry IEN
78 ;
79 ; ROR8DST Closed root of the destination array
80 ;
81 ; [FLAGS] Flags that control the execution (can be combined):
82 ; E Count patients with errors in the
83 ; ROR PATIENT EVENTS file
84 ; P Include list of pending patients
85 ; S Show the progress indicator
86 ;
87 ; @ROR8DST@(
88 ; "DTACKMAX") The latest and the earliest dates by which
89 ; "DTACKMIN") patient data transmissions are acknowledged
90 ;
91 ; "NPA") Number of active patients
92 ; "NPE") Number of patients with errors in the
93 ; ROR PATIENT EVENTS file
94 ; "NPP") Number of pending patients
95 ; "NPT") Total number of patients in the registry
96 ; (including pending)
97 ;
98 ; "PPL",
99 ; 0,1) Map of the corresponding data subnode
100 ; (field names separated by ^)
101 ; DFN) Pending patient
102 ; ^01: IEN of the registry record
103 ; ^02: Coded SSN
104 ; DFN,1)
105 ; Dates of the selection rules
106 ; ^01: LAB
107 ; ^02: PROBLEM
108 ; ^03: PTF
109 ; ^04: VISIT
110 ;
111 ; Return Values:
112 ; <0 Error code
113 ; 0 Ok
114 ; >0 Number of ignored errors
115 ;
116REGINFO(REGIEN,ROR8DST,FLAGS) ;
117 N RORECNT ; Number of errors
118 N RORSRL ; List of selection rules
119 ;
120 N COUNTS,CPPL,DTACKMIN,DTACKMAX,IEN,IENS,NODE,PTSTAT,RC,RORBUF,RORMSG,SPI,TMP
121 S FLAGS=$G(FLAGS),SPI=(FLAGS["S"),CPPL=(FLAGS["P")
122 S DTACKMIN=999999999,DTACKMAX=0
123 K @ROR8DST S (RC,RORECNT)=0
124 ;
125 ;--- Load the list of selection rules
126 I CPPL S RC=$$LOADSRL(REGIEN,.RORSRL) Q:RC<0 RC
127 ;
128 ;--- Examine registry records
129 W:SPI !,"Examining registry records",!
130 S NODE=$$ROOT^DILFD(798,,1)
131 S IEN=0
132 F S IEN=$O(@NODE@("AC",REGIEN,IEN)) Q:IEN'>0 D
133 . W:SPI "."
134 . S COUNTS("NPT")=$G(COUNTS("NPT"))+1 ; Total number of patients
135 . ;--- Load the data
136 . S IENS=IEN_"," K RORBUF
137 . D GETS^DIQ(798,IENS,".01;3;9.1","I","RORBUF","RORMSG")
138 . I $G(DIERR) D S RORECNT=RORECNT+1 Q
139 . . D DBS^RORERR("RORMSG",-9,,,798,IENS)
140 . S PTSTAT=+$G(RORBUF(798,IENS,3,"I"))
141 . ;--- Number of active patients
142 . D:$$ACTIVE^RORDD(IEN)
143 . . S COUNTS("NPA")=$G(COUNTS("NPA"))+1
144 . . S TMP=+$G(RORBUF(798,IENS,9.1,"I"))
145 . . I TMP>0 S:TMP<DTACKMIN DTACKMIN=TMP S:TMP>DTACKMAX DTACKMAX=TMP
146 . ;--- Add a pending patient to the list
147 . I PTSTAT=4 D:CPPL S COUNTS("NPP")=$G(COUNTS("NPP"))+1
148 . . S TMP=$$ADDPP(REGIEN,IEN,+RORBUF(798,IENS,.01,"I"))
149 ;
150 ;--- Count patients with errors
151 I FLAGS["E" D Q:RC<0 RC S @ROR8DST@("NPE")=RC
152 . S RC=$$PTERR(REGIEN,SPI)
153 ;
154 ;--- Success
155 I DTACKMAX>0 D
156 . S @ROR8DST@("DTACKMIN")=DTACKMIN
157 . S @ROR8DST@("DTACKMAX")=DTACKMAX
158 E F TMP="MIN","MAX" S @ROR8DST@("DTACK"_TMP)=""
159 I CPPL D:$G(COUNTS("NPP"))>0
160 . S RORBUF="",TMP=0
161 . F S TMP=$O(RORSRL(TMP)) Q:TMP'>0 D
162 . . S $P(RORBUF,U,+RORSRL(TMP))=$P(RORSRL(TMP),U,2)
163 . S @ROR8DST@("PPL",0,1)=RORBUF
164 F TMP="NPA","NPP","NPT" S @ROR8DST@(TMP)=+$G(COUNTS(TMP))
165 Q RORECNT
166 ;
167 ;***** E-MAILS THE INFORMATION ABOUT THE REGISTRY
168 ;
169 ; REGIEN Registry IEN
170 ;
171 ; [EMAIL] E-mail address where the data will be sent to
172 ;
173 ; [FLAGS] Flags that control the execution (can be combined):
174 ; E Count patients with errors in the
175 ; ROR PATIENT EVENTS file
176 ; P Include list of pending patients
177 ; S Show the progress indicator
178 ;
179 ; Return Values:
180 ; <0 Error code
181 ; 0 Ok
182 ;
183SENDINFO(REGIEN,EMAIL,FLAGS) ;
184 Q:'$$CCRNTFY^RORUTL05(REGIEN) 0
185 N DATE,IENS,INFO,MSGBUF,PARAMS,RC,RORBUF,RORMSG,TMP
186 S FLAGS=$G(FLAGS)
187 S INFO=$$ALLOC^RORTMP(),RC=0
188 S MSGBUF=$$ALLOC^RORTMP()
189 S PARAMS("DATE")=$$DATE($$DT^XLFDT)
190 ;
191 ;--- Gather the information
192 S RC=$$REGINFO(REGIEN,INFO,FLAGS)
193 ;
194 D:RC'<0
195 . N I,MBI,NF,PATIEN,XMCHAN,XMDUZ,XMLOC,XMSUB,XMTEXT,XMY,XMZ
196 . S IENS=REGIEN_"," K @MSGBUF
197 . ;
198 . ;--- Load the registry parameters
199 . D GETS^DIQ(798.1,IENS,".01;1;2;13.3;19.3","I","RORBUF","RORMSG")
200 . I $G(DIERR) S RC=$$DBS^RORERR("RORMSG",-9,,,798.1,IENS) Q
201 . I $G(EMAIL)="" S EMAIL=$G(RORBUF(798.1,IENS,13.3,"I")) Q:EMAIL=""
202 . ;
203 . ;--- Header of the message body
204 . S TMP=$$SITE^RORUTL03()
205 . S PARAMS("STNAME")=$P(TMP,U,2)
206 . S PARAMS("STNUM")=$P(TMP,U)
207 . ;---
208 . F I="DTACKMAX","DTACKMIN" D
209 . . S PARAMS(I)=$$DATE(+$G(@INFO@(I)))
210 . F I="NPA","NPP","NPT" D
211 . . S PARAMS(I)=+$G(@INFO@(I))
212 . ;---
213 . S PARAMS("REGISTRY")=$G(RORBUF(798.1,IENS,.01,"I"))
214 . S PARAMS("RETRIES")=+$G(RORBUF(798.1,IENS,19.3,"I"))
215 . S PARAMS("UPDATED_UNTIL")=$$DATE($G(RORBUF(798.1,IENS,1,"I")))
216 . S PARAMS("EXTRACTED_UNTIL")=$$DATE($G(RORBUF(798.1,IENS,2,"I")))
217 . D BLD^DIALOG(7980000.021,.PARAMS,,MSGBUF,"S")
218 . S MBI=+$O(@MSGBUF@(""),-1)
219 . ;
220 . ;--- Number of patients with errors
221 . D:FLAGS["E"
222 . . S MBI=MBI+1,@MSGBUF@(MBI)="<NPE>"_$G(@INFO@("NPE"))_"</NPE>"
223 . ;
224 . ;--- List of pending patients
225 . D:FLAGS["P"
226 . . S RORBUF=$G(@INFO@("PPL",0,1))
227 . . F NF=1:1 Q:$P(RORBUF,U,NF)=""
228 . . S NF=NF-1
229 . . S MBI=MBI+1,@MSGBUF@(MBI)="<PPLIST>"
230 . . S MBI=MBI+1,@MSGBUF@(MBI)="CSSN,"_$TR(RORBUF,U,",")
231 . . S PATIEN=0
232 . . F S PATIEN=$O(@INFO@("PPL",PATIEN)) Q:PATIEN'>0 D
233 . . . S RORBUF=$G(@INFO@("PPL",PATIEN,1))
234 . . . F I=1:1:NF S $P(RORBUF,U,I)=$$DATE(+$P(RORBUF,U,I))
235 . . . S TMP=$P(@INFO@("PPL",PATIEN),U,2)
236 . . . S MBI=MBI+1,@MSGBUF@(MBI)=TMP_","_$TR(RORBUF,U,",")
237 . . S MBI=MBI+1,@MSGBUF@(MBI)="</PPLIST>"
238 . ;
239 . ;--- Footer of the message body
240 . D BLD^DIALOG(7980000.022,.PARAMS,,MSGBUF,"S")
241 . ;
242 . ;--- Send the message
243 . S XMDUZ=.5,XMY(EMAIL)=""
244 . S XMSUB="ROR: REGISTRY INFO"
245 . S XMTEXT=$$OREF^DILF(MSGBUF)
246 . D ^XMD
247 ;
248 ;--- Cleanup
249 D FREE^RORTMP(INFO),FREE^RORTMP(MSGBUF)
250 Q $S(RC<0:RC,1:0)
Note: See TracBrowser for help on using the repository browser.