source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/ROR11.m@ 1611

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

initial load of FOIAVistA 6/30/08 version
File size: 7.1 KB
Line 
1ROR11 ;HCIOFO/SG - NIGHTLY TASK UTILITIES ; 12/7/05 9:40am
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 ; RORLBLST ------------ LIST OF LATEST HL7 MESSAGES
5 ;
6 ; RORLBLST(
7 ; MsgID, Internal Batch ID
8 ; "MS") Message Status (see $$MSGSTAT^HLUTIL)
9 ; ^01: Status Code
10 ; ^02: Status Updated
11 ; ^03: Error Message
12 ; ^04: Error Type pointer
13 ; ^05: Queue Position or Number of Retries
14 ; ^06: Open Failed
15 ; ^07: ACK Timeout
16 ; "RL",
17 ; RegIEN) IENS of the message reference in the
18 ; registry parameters (sub-file #798.122)
19 ;
20 ; "N", Created and used by the NOTIFY^ROR11
21 ; EMail,
22 ; RegName) RegIEN
23 ;
24 ; "RM",
25 ; RegIEN, ""
26 ; MsgID) ""
27 ;
28 Q
29 ;
30 ;***** ADDS THE HL7 BATCH MESSAGE TO THE LIST
31 ;
32 ; MSGID Batch HL7 Message Control ID
33 ; IENS IENS of the message reference in the reigstry
34 ; parameters (sub-file #798.122)
35 ; IBID Internal Batch ID
36 ; DATE Date/Time of the batch
37 ;
38ADDMSG(MSGID,IENS,IBID,DATE) ;
39 N REGIEN S REGIEN=$P(IENS,",",2)
40 D:'$D(RORLBLST(MSGID))
41 . S RORLBLST(MSGID,"MS")=$$MSGSTAT^HLUTIL(MSGID)
42 . S RORLBLST(MSGID,"DT")=DATE
43 . S RORLBLST(MSGID)=IBID
44 S RORLBLST(MSGID,"RL",REGIEN)=IENS
45 S RORLBLST("RM",REGIEN,MSGID)=""
46 S RORLBLST("RM",REGIEN)=""
47 Q
48 ;
49 ;***** REMOVES THE HL7 BATCH MESSAGE FROM THE LIST
50 ;
51 ; MSGID Batch HL7 Message Control ID
52 ; [.FDA] Reference to the FDA arrays that will be updated
53 ; to remove the references to the message
54 ;
55DELMSG(MSGID,FDA) ;
56 N IENS,REGIEN S REGIEN=""
57 F S REGIEN=$O(RORLBLST(MSGID,"RL",REGIEN)) Q:REGIEN="" D
58 . S IENS=$P(RORLBLST(MSGID,"RL",REGIEN),U)
59 . S:IENS'="" FDA(798.122,IENS,.01)="@"
60 . K RORLBLST("RM",REGIEN,MSGID)
61 K RORLBLST(MSGID)
62 Q
63 ;
64 ;***** NOTIFIES THE AAC AND LOCAL COORDINATORS
65NOTIFY() ;
66 Q:$D(RORLBLST("RM"))<10
67 N ALNOR,EMAIL,IENS,MSGID,NOR,PARAMS,REGIEN,REGNAME,RORBUF,RORMSG,RORTXT,RORXML,TMP
68 K RORLBLST("N")
69 ;
70 ;=== Send local alerts and generate the notification list
71 S REGIEN=0
72 F S REGIEN=$O(RORLBLST("RM",REGIEN)) Q:REGIEN'>0 D
73 . K RORBUF,RORMSG,RORTXT S IENS=REGIEN_","
74 . ;--- Load the notification parameters
75 . D GETS^DIQ(798.1,IENS,".01;13.2;13.3;19.3",,"RORBUF","RORMSG")
76 . I $G(DIERR) D DBS^RORERR("RORMSG",-9,,,798.1,IENS) Q
77 . ;--- Check if the notification should be sent
78 . S ALNOR=+$G(RORBUF(798.1,IENS,13.2)) ; ALERT FREQUENCY
79 . S NOR=+$G(RORBUF(798.1,IENS,19.3)) ; HL7 ATTEMPT COUNTER
80 . Q:$S(ALNOR'>0:1,1:NOR#ALNOR)
81 . ;---
82 . S REGNAME=$G(RORBUF(798.1,IENS,.01)) ; Registry Name
83 . S EMAIL=$G(RORBUF(798.1,IENS,13.3)) ; Notification E-mail
84 . S PARAMS("REGISTRY")=REGNAME
85 . S PARAMS("NOR")=NOR
86 . ;--- Error message header
87 . D BLD^DIALOG(7980000.023,.PARAMS,,"RORTXT","S")
88 . ;--- Append the list of unsent HL7 messages
89 . S MSGID=""
90 . F S MSGID=$O(RORLBLST("RM",REGIEN,MSGID)) Q:MSGID="" D
91 . . S MSGSTAT=RORLBLST(MSGID,"MS")
92 . . S RORTXT($O(RORTXT(""),-1)+1)=""
93 . . D MSG7STS^RORUTL05(MSGID,.RORTXT,,7980000.004,.PARAMS,MSGSTAT)
94 . ;--- Error message footer
95 . D BLD^DIALOG(7980000.024,.PARAMS,,"RORTXT")
96 . ;--- Record the error message
97 . D LOG^RORERR(-67,.RORTXT,,NOR)
98 . ;--- Notify local staff
99 . S TMP=REGNAME_U_NOR
100 . D ALERT^RORUTL01(REGNAME,-67,"ALERT^ROR10",TMP,,NOR)
101 . ;--- Update the national notification list
102 . D:$$CCRNTFY^RORUTL05(REGIEN)
103 . . S:EMAIL'="" RORLBLST("N",EMAIL,REGNAME)=REGIEN
104 ;
105 ;=== Get station name and number
106 S TMP=$$SITE^RORUTL03()
107 S PARAMS("STNAME")=$P(TMP,U,2)
108 S PARAMS("STNUM")=$P(TMP,U)
109 ;
110 ;=== Generate notification e-mails
111 S EMAIL=""
112 F S EMAIL=$O(RORLBLST("N",EMAIL)) Q:EMAIL="" D
113 . K RORXML
114 . ;--- E-mail header
115 . D BLD^DIALOG(7980000.025,.PARAMS,,"RORXML","S")
116 . ;--- Process affected registries
117 . S REGNAME=""
118 . F S REGNAME=$O(RORLBLST("N",EMAIL,REGNAME)) Q:REGNAME="" D
119 . . S REGIEN=+RORLBLST("N",EMAIL,REGNAME)
120 . . S PARAMS("REGISTRY")=REGNAME
121 . . S PARAMS("NOR")=NOR
122 . . ;--- Append registry section
123 . . D NTFXML("<REGISTRY>")
124 . . D NTFXML("<NAME>"_REGNAME_"</NAME>")
125 . . S TMP=$P($$REGNAME^RORUTL01(REGIEN),U,2)
126 . . D NTFXML("<DESCRIPTION>"_TMP_"</DESCRIPTION>")
127 . . ;--- Append message list
128 . . S MSGID=""
129 . . F S MSGID=$O(RORLBLST("RM",REGIEN,MSGID)) Q:MSGID="" D
130 . . . S MSGSTAT=RORLBLST(MSGID,"MS")
131 . . . D MSG7STS^RORUTL05(MSGID,.RORXML,,7980000.002,.PARAMS,MSGSTAT)
132 . . ;--- Close the registry section
133 . . D NTFXML("</REGISTRY>")
134 . ;--- E-mail footer
135 . D BLD^DIALOG(7980000.026,.PARAMS,,"RORXML","S")
136 . ;--- Send the e-mail
137 . D
138 . . N XMCHAN,XMDUZ,XMLOC,XMSUB,XMTEXT,XMY,XMZ
139 . . S XMDUZ=.5,XMY(EMAIL)=""
140 . . S XMSUB="ROR: HL7 PROBLEM"
141 . . S XMTEXT="RORXML("
142 . . D ^XMD
143 Q
144 ;
145NTFXML(STR) ;
146 S RORXML($O(RORXML(""),-1)+1)=STR
147 Q
148 ;
149 ;***** UPDATES REGISTRY RECORDS AFTER SUCCESSFUL DATA TRANSMISSION
150 ;
151 ; BATCHID Internal HL7 batch ID
152 ; BATCHDT Date/Time of the batch
153 ;
154 ; Return values:
155 ; <0 Error code
156 ; 0 Ok
157 ;
158UPDTRR(BATCHID,BATCHDT) ;
159 N IEN,IENS,LBI,MSGID,PATIEN,REGIEN,RORBUF,RORFDA,RORMSG,TMP,XREF
160 S XREF=$$ROOT^DILFD(798)_"""AM"")"
161 S LBI=$L(BATCHID)
162 ;===
163 S MSGID=BATCHID
164 F S MSGID=$O(@XREF@(MSGID)) Q:$E(MSGID,1,LBI)'=BATCHID D
165 . S IEN=0
166 . F S IEN=$O(@XREF@(MSGID,IEN)) Q:IEN'>0 D
167 . . S IENS=IEN_"," K RORBUF,RORFDA,RORMSG
168 . . ;=== Load the registry record
169 . . S TMP=".01;.02;3;4;4.1;5;5.1;6;9.1;9.2;10"
170 . . D GETS^DIQ(798,IENS,TMP,"I","RORBUF","RORMSG")
171 . . S PATIEN=$G(RORBUF(798,IENS,.01,"I"))
172 . . I $G(DIERR) D DBS^RORERR("RORMSG",-9,,PATIEN,798,IENS) Q
173 . . S REGIEN=+$G(RORBUF(798,IENS,.02,"I"))
174 . . ;
175 . . ;=== Update record state only if the corresponding HL7 message
176 . . ;=== was actually generated (check for fake Message ID)
177 . . I $P($G(RORBUF(798,IENS,10,"I")),"-",2) S RC=0 D Q:RC
178 . . . ;--- Delete a record marked for deletion (only if the deletion
179 . . . ;--- date/time is earlier than the last message timestamp)
180 . . . I $G(RORBUF(798,IENS,3,"I"))=5 D Q
181 . . . . Q:$G(RORBUF(798,IENS,6,"I"))'<BATCHDT
182 . . . . N DA,DIK S RC=1
183 . . . . S DIK=$$ROOT^DILFD(798),DA=IEN D ^DIK
184 . . . . S TMP=$$REGNAME^RORUTL01(REGIEN)
185 . . . . D LOG^RORERR(-90,,PATIEN,$P(TMP,U))
186 . . . ;--- Reset the UPDATE DEMOGRAPHICS flag if the demographic
187 . . . ;--- data was updated before the latest data extraction
188 . . . D:$G(RORBUF(798,IENS,4,"I"))
189 . . . . S:$G(RORBUF(798,IENS,4.1,"I"))<BATCHDT RORFDA(798,IENS,4)="@"
190 . . . ;--- Reset the UPDATE LOCAL REGISTRY DATA flag if the local
191 . . . ;--- data was updated before the latest data extraction
192 . . . D:$G(RORBUF(798,IENS,5,"I"))
193 . . . . S:$G(RORBUF(798,IENS,5.1,"I"))<BATCHDT RORFDA(798,IENS,5)="@"
194 . . ;
195 . . ;=== Update extraction dates
196 . . S TMP=+$G(RORBUF(798,IENS,9.2,"I"))
197 . . S:TMP>$G(RORBUF(798,IENS,9.1)) RORFDA(798,IENS,9.1)=TMP
198 . . ;=== Clear the message ID
199 . . S RORFDA(798,IENS,10)="@"
200 . . ;=== Update the registry record (if necessary)
201 . . D:$D(RORFDA)>1
202 . . . D FILE^DIE(,"RORFDA","RORMSG")
203 . . . D:$G(DIERR) DBS^RORERR("RORMSG",-9,,PATIEN,798,IENS)
204 ;===
205 Q 0
Note: See TracBrowser for help on using the repository browser.