ROR11 ;HCIOFO/SG - NIGHTLY TASK UTILITIES ; 12/7/05 9:40am
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
;
; RORLBLST ------------ LIST OF LATEST HL7 MESSAGES
;
; RORLBLST(
; MsgID, Internal Batch ID
; "MS") Message Status (see $$MSGSTAT^HLUTIL)
; ^01: Status Code
; ^02: Status Updated
; ^03: Error Message
; ^04: Error Type pointer
; ^05: Queue Position or Number of Retries
; ^06: Open Failed
; ^07: ACK Timeout
; "RL",
; RegIEN) IENS of the message reference in the
; registry parameters (sub-file #798.122)
;
; "N", Created and used by the NOTIFY^ROR11
; EMail,
; RegName) RegIEN
;
; "RM",
; RegIEN, ""
; MsgID) ""
;
Q
;
;***** ADDS THE HL7 BATCH MESSAGE TO THE LIST
;
; MSGID Batch HL7 Message Control ID
; IENS IENS of the message reference in the reigstry
; parameters (sub-file #798.122)
; IBID Internal Batch ID
; DATE Date/Time of the batch
;
ADDMSG(MSGID,IENS,IBID,DATE) ;
N REGIEN S REGIEN=$P(IENS,",",2)
D:'$D(RORLBLST(MSGID))
. S RORLBLST(MSGID,"MS")=$$MSGSTAT^HLUTIL(MSGID)
. S RORLBLST(MSGID,"DT")=DATE
. S RORLBLST(MSGID)=IBID
S RORLBLST(MSGID,"RL",REGIEN)=IENS
S RORLBLST("RM",REGIEN,MSGID)=""
S RORLBLST("RM",REGIEN)=""
Q
;
;***** REMOVES THE HL7 BATCH MESSAGE FROM THE LIST
;
; MSGID Batch HL7 Message Control ID
; [.FDA] Reference to the FDA arrays that will be updated
; to remove the references to the message
;
DELMSG(MSGID,FDA) ;
N IENS,REGIEN S REGIEN=""
F S REGIEN=$O(RORLBLST(MSGID,"RL",REGIEN)) Q:REGIEN="" D
. S IENS=$P(RORLBLST(MSGID,"RL",REGIEN),U)
. S:IENS'="" FDA(798.122,IENS,.01)="@"
. K RORLBLST("RM",REGIEN,MSGID)
K RORLBLST(MSGID)
Q
;
;***** NOTIFIES THE AAC AND LOCAL COORDINATORS
NOTIFY() ;
Q:$D(RORLBLST("RM"))<10
N ALNOR,EMAIL,IENS,MSGID,NOR,PARAMS,REGIEN,REGNAME,RORBUF,RORMSG,RORTXT,RORXML,TMP
K RORLBLST("N")
;
;=== Send local alerts and generate the notification list
S REGIEN=0
F S REGIEN=$O(RORLBLST("RM",REGIEN)) Q:REGIEN'>0 D
. K RORBUF,RORMSG,RORTXT S IENS=REGIEN_","
. ;--- Load the notification parameters
. D GETS^DIQ(798.1,IENS,".01;13.2;13.3;19.3",,"RORBUF","RORMSG")
. I $G(DIERR) D DBS^RORERR("RORMSG",-9,,,798.1,IENS) Q
. ;--- Check if the notification should be sent
. S ALNOR=+$G(RORBUF(798.1,IENS,13.2)) ; ALERT FREQUENCY
. S NOR=+$G(RORBUF(798.1,IENS,19.3)) ; HL7 ATTEMPT COUNTER
. Q:$S(ALNOR'>0:1,1:NOR#ALNOR)
. ;---
. S REGNAME=$G(RORBUF(798.1,IENS,.01)) ; Registry Name
. S EMAIL=$G(RORBUF(798.1,IENS,13.3)) ; Notification E-mail
. S PARAMS("REGISTRY")=REGNAME
. S PARAMS("NOR")=NOR
. ;--- Error message header
. D BLD^DIALOG(7980000.023,.PARAMS,,"RORTXT","S")
. ;--- Append the list of unsent HL7 messages
. S MSGID=""
. F S MSGID=$O(RORLBLST("RM",REGIEN,MSGID)) Q:MSGID="" D
. . S MSGSTAT=RORLBLST(MSGID,"MS")
. . S RORTXT($O(RORTXT(""),-1)+1)=""
. . D MSG7STS^RORUTL05(MSGID,.RORTXT,,7980000.004,.PARAMS,MSGSTAT)
. ;--- Error message footer
. D BLD^DIALOG(7980000.024,.PARAMS,,"RORTXT")
. ;--- Record the error message
. D LOG^RORERR(-67,.RORTXT,,NOR)
. ;--- Notify local staff
. S TMP=REGNAME_U_NOR
. D ALERT^RORUTL01(REGNAME,-67,"ALERT^ROR10",TMP,,NOR)
. ;--- Update the national notification list
. D:$$CCRNTFY^RORUTL05(REGIEN)
. . S:EMAIL'="" RORLBLST("N",EMAIL,REGNAME)=REGIEN
;
;=== Get station name and number
S TMP=$$SITE^RORUTL03()
S PARAMS("STNAME")=$P(TMP,U,2)
S PARAMS("STNUM")=$P(TMP,U)
;
;=== Generate notification e-mails
S EMAIL=""
F S EMAIL=$O(RORLBLST("N",EMAIL)) Q:EMAIL="" D
. K RORXML
. ;--- E-mail header
. D BLD^DIALOG(7980000.025,.PARAMS,,"RORXML","S")
. ;--- Process affected registries
. S REGNAME=""
. F S REGNAME=$O(RORLBLST("N",EMAIL,REGNAME)) Q:REGNAME="" D
. . S REGIEN=+RORLBLST("N",EMAIL,REGNAME)
. . S PARAMS("REGISTRY")=REGNAME
. . S PARAMS("NOR")=NOR
. . ;--- Append registry section
. . D NTFXML("<REGISTRY>")
. . D NTFXML("<NAME>"_REGNAME_"</NAME>")
. . S TMP=$P($$REGNAME^RORUTL01(REGIEN),U,2)
. . D NTFXML("<DESCRIPTION>"_TMP_"</DESCRIPTION>")
. . ;--- Append message list
. . S MSGID=""
. . F S MSGID=$O(RORLBLST("RM",REGIEN,MSGID)) Q:MSGID="" D
. . . S MSGSTAT=RORLBLST(MSGID,"MS")
. . . D MSG7STS^RORUTL05(MSGID,.RORXML,,7980000.002,.PARAMS,MSGSTAT)
. . ;--- Close the registry section
. . D NTFXML("</REGISTRY>")
. ;--- E-mail footer
. D BLD^DIALOG(7980000.026,.PARAMS,,"RORXML","S")
. ;--- Send the e-mail
. D
. . N XMCHAN,XMDUZ,XMLOC,XMSUB,XMTEXT,XMY,XMZ
. . S XMDUZ=.5,XMY(EMAIL)=""
. . S XMSUB="ROR: HL7 PROBLEM"
. . S XMTEXT="RORXML("
. . D ^XMD
Q
;
NTFXML(STR) ;
S RORXML($O(RORXML(""),-1)+1)=STR
Q
;
;***** UPDATES REGISTRY RECORDS AFTER SUCCESSFUL DATA TRANSMISSION
;
; BATCHID Internal HL7 batch ID
; BATCHDT Date/Time of the batch
;
; Return values:
; <0 Error code
; 0 Ok
;
UPDTRR(BATCHID,BATCHDT) ;
N IEN,IENS,LBI,MSGID,PATIEN,REGIEN,RORBUF,RORFDA,RORMSG,TMP,XREF
S XREF=$$ROOT^DILFD(798)_"""AM"")"
S LBI=$L(BATCHID)
;===
S MSGID=BATCHID
F S MSGID=$O(@XREF@(MSGID)) Q:$E(MSGID,1,LBI)'=BATCHID D
. S IEN=0
. F S IEN=$O(@XREF@(MSGID,IEN)) Q:IEN'>0 D
. . S IENS=IEN_"," K RORBUF,RORFDA,RORMSG
. . ;=== Load the registry record
. . S TMP=".01;.02;3;4;4.1;5;5.1;6;9.1;9.2;10"
. . D GETS^DIQ(798,IENS,TMP,"I","RORBUF","RORMSG")
. . S PATIEN=$G(RORBUF(798,IENS,.01,"I"))
. . I $G(DIERR) D DBS^RORERR("RORMSG",-9,,PATIEN,798,IENS) Q
. . S REGIEN=+$G(RORBUF(798,IENS,.02,"I"))
. . ;
. . ;=== Update record state only if the corresponding HL7 message
. . ;=== was actually generated (check for fake Message ID)
. . I $P($G(RORBUF(798,IENS,10,"I")),"-",2) S RC=0 D Q:RC
. . . ;--- Delete a record marked for deletion (only if the deletion
. . . ;--- date/time is earlier than the last message timestamp)
. . . I $G(RORBUF(798,IENS,3,"I"))=5 D Q
. . . . Q:$G(RORBUF(798,IENS,6,"I"))'<BATCHDT
. . . . N DA,DIK S RC=1
. . . . S DIK=$$ROOT^DILFD(798),DA=IEN D ^DIK
. . . . S TMP=$$REGNAME^RORUTL01(REGIEN)
. . . . D LOG^RORERR(-90,,PATIEN,$P(TMP,U))
. . . ;--- Reset the UPDATE DEMOGRAPHICS flag if the demographic
. . . ;--- data was updated before the latest data extraction
. . . D:$G(RORBUF(798,IENS,4,"I"))
. . . . S:$G(RORBUF(798,IENS,4.1,"I"))<BATCHDT RORFDA(798,IENS,4)="@"
. . . ;--- Reset the UPDATE LOCAL REGISTRY DATA flag if the local
. . . ;--- data was updated before the latest data extraction
. . . D:$G(RORBUF(798,IENS,5,"I"))
. . . . S:$G(RORBUF(798,IENS,5.1,"I"))<BATCHDT RORFDA(798,IENS,5)="@"
. . ;
. . ;=== Update extraction dates
. . S TMP=+$G(RORBUF(798,IENS,9.2,"I"))
. . S:TMP>$G(RORBUF(798,IENS,9.1)) RORFDA(798,IENS,9.1)=TMP
. . ;=== Clear the message ID
. . S RORFDA(798,IENS,10)="@"
. . ;=== Update the registry record (if necessary)
. . D:$D(RORFDA)>1
. . . D FILE^DIE(,"RORFDA","RORMSG")
. . . D:$G(DIERR) DBS^RORERR("RORMSG",-9,,PATIEN,798,IENS)
;===
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HROR11 7455 printed Apr 09, 2024@20:48:26 Page 2
ROR11 ;HCIOFO/SG - NIGHTLY TASK UTILITIES ; 12/7/05 9:40am
+1 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
+2 ;
+3 ; RORLBLST ------------ LIST OF LATEST HL7 MESSAGES
+4 ;
+5 ; RORLBLST(
+6 ; MsgID, Internal Batch ID
+7 ; "MS") Message Status (see $$MSGSTAT^HLUTIL)
+8 ; ^01: Status Code
+9 ; ^02: Status Updated
+10 ; ^03: Error Message
+11 ; ^04: Error Type pointer
+12 ; ^05: Queue Position or Number of Retries
+13 ; ^06: Open Failed
+14 ; ^07: ACK Timeout
+15 ; "RL",
+16 ; RegIEN) IENS of the message reference in the
+17 ; registry parameters (sub-file #798.122)
+18 ;
+19 ; "N", Created and used by the NOTIFY^ROR11
+20 ; EMail,
+21 ; RegName) RegIEN
+22 ;
+23 ; "RM",
+24 ; RegIEN, ""
+25 ; MsgID) ""
+26 ;
+27 QUIT
+28 ;
+29 ;***** ADDS THE HL7 BATCH MESSAGE TO THE LIST
+30 ;
+31 ; MSGID Batch HL7 Message Control ID
+32 ; IENS IENS of the message reference in the reigstry
+33 ; parameters (sub-file #798.122)
+34 ; IBID Internal Batch ID
+35 ; DATE Date/Time of the batch
+36 ;
ADDMSG(MSGID,IENS,IBID,DATE) ;
+1 NEW REGIEN
SET REGIEN=$PIECE(IENS,",",2)
+2 if '$DATA(RORLBLST(MSGID))
Begin DoDot:1
+3 SET RORLBLST(MSGID,"MS")=$$MSGSTAT^HLUTIL(MSGID)
+4 SET RORLBLST(MSGID,"DT")=DATE
+5 SET RORLBLST(MSGID)=IBID
End DoDot:1
+6 SET RORLBLST(MSGID,"RL",REGIEN)=IENS
+7 SET RORLBLST("RM",REGIEN,MSGID)=""
+8 SET RORLBLST("RM",REGIEN)=""
+9 QUIT
+10 ;
+11 ;***** REMOVES THE HL7 BATCH MESSAGE FROM THE LIST
+12 ;
+13 ; MSGID Batch HL7 Message Control ID
+14 ; [.FDA] Reference to the FDA arrays that will be updated
+15 ; to remove the references to the message
+16 ;
DELMSG(MSGID,FDA) ;
+1 NEW IENS,REGIEN
SET REGIEN=""
+2 FOR
SET REGIEN=$ORDER(RORLBLST(MSGID,"RL",REGIEN))
if REGIEN=""
QUIT
Begin DoDot:1
+3 SET IENS=$PIECE(RORLBLST(MSGID,"RL",REGIEN),U)
+4 if IENS'=""
SET FDA(798.122,IENS,.01)="@"
+5 KILL RORLBLST("RM",REGIEN,MSGID)
End DoDot:1
+6 KILL RORLBLST(MSGID)
+7 QUIT
+8 ;
+9 ;***** NOTIFIES THE AAC AND LOCAL COORDINATORS
NOTIFY() ;
+1 if $DATA(RORLBLST("RM"))<10
QUIT
+2 NEW ALNOR,EMAIL,IENS,MSGID,NOR,PARAMS,REGIEN,REGNAME,RORBUF,RORMSG,RORTXT,RORXML,TMP
+3 KILL RORLBLST("N")
+4 ;
+5 ;=== Send local alerts and generate the notification list
+6 SET REGIEN=0
+7 FOR
SET REGIEN=$ORDER(RORLBLST("RM",REGIEN))
if REGIEN'>0
QUIT
Begin DoDot:1
+8 KILL RORBUF,RORMSG,RORTXT
SET IENS=REGIEN_","
+9 ;--- Load the notification parameters
+10 DO GETS^DIQ(798.1,IENS,".01;13.2;13.3;19.3",,"RORBUF","RORMSG")
+11 IF $GET(DIERR)
DO DBS^RORERR("RORMSG",-9,,,798.1,IENS)
QUIT
+12 ;--- Check if the notification should be sent
+13 ; ALERT FREQUENCY
SET ALNOR=+$GET(RORBUF(798.1,IENS,13.2))
+14 ; HL7 ATTEMPT COUNTER
SET NOR=+$GET(RORBUF(798.1,IENS,19.3))
+15 if $SELECT(ALNOR'>0
QUIT
+16 ;---
+17 ; Registry Name
SET REGNAME=$GET(RORBUF(798.1,IENS,.01))
+18 ; Notification E-mail
SET EMAIL=$GET(RORBUF(798.1,IENS,13.3))
+19 SET PARAMS("REGISTRY")=REGNAME
+20 SET PARAMS("NOR")=NOR
+21 ;--- Error message header
+22 DO BLD^DIALOG(7980000.023,.PARAMS,,"RORTXT","S")
+23 ;--- Append the list of unsent HL7 messages
+24 SET MSGID=""
+25 FOR
SET MSGID=$ORDER(RORLBLST("RM",REGIEN,MSGID))
if MSGID=""
QUIT
Begin DoDot:2
+26 SET MSGSTAT=RORLBLST(MSGID,"MS")
+27 SET RORTXT($ORDER(RORTXT(""),-1)+1)=""
+28 DO MSG7STS^RORUTL05(MSGID,.RORTXT,,7980000.004,.PARAMS,MSGSTAT)
End DoDot:2
+29 ;--- Error message footer
+30 DO BLD^DIALOG(7980000.024,.PARAMS,,"RORTXT")
+31 ;--- Record the error message
+32 DO LOG^RORERR(-67,.RORTXT,,NOR)
+33 ;--- Notify local staff
+34 SET TMP=REGNAME_U_NOR
+35 DO ALERT^RORUTL01(REGNAME,-67,"ALERT^ROR10",TMP,,NOR)
+36 ;--- Update the national notification list
+37 if $$CCRNTFY^RORUTL05(REGIEN)
Begin DoDot:2
+38 if EMAIL'=""
SET RORLBLST("N",EMAIL,REGNAME)=REGIEN
End DoDot:2
End DoDot:1
+39 ;
+40 ;=== Get station name and number
+41 SET TMP=$$SITE^RORUTL03()
+42 SET PARAMS("STNAME")=$PIECE(TMP,U,2)
+43 SET PARAMS("STNUM")=$PIECE(TMP,U)
+44 ;
+45 ;=== Generate notification e-mails
+46 SET EMAIL=""
+47 FOR
SET EMAIL=$ORDER(RORLBLST("N",EMAIL))
if EMAIL=""
QUIT
Begin DoDot:1
+48 KILL RORXML
+49 ;--- E-mail header
+50 DO BLD^DIALOG(7980000.025,.PARAMS,,"RORXML","S")
+51 ;--- Process affected registries
+52 SET REGNAME=""
+53 FOR
SET REGNAME=$ORDER(RORLBLST("N",EMAIL,REGNAME))
if REGNAME=""
QUIT
Begin DoDot:2
+54 SET REGIEN=+RORLBLST("N",EMAIL,REGNAME)
+55 SET PARAMS("REGISTRY")=REGNAME
+56 SET PARAMS("NOR")=NOR
+57 ;--- Append registry section
+58 DO NTFXML("<REGISTRY>")
+59 DO NTFXML("<NAME>"_REGNAME_"</NAME>")
+60 SET TMP=$PIECE($$REGNAME^RORUTL01(REGIEN),U,2)
+61 DO NTFXML("<DESCRIPTION>"_TMP_"</DESCRIPTION>")
+62 ;--- Append message list
+63 SET MSGID=""
+64 FOR
SET MSGID=$ORDER(RORLBLST("RM",REGIEN,MSGID))
if MSGID=""
QUIT
Begin DoDot:3
+65 SET MSGSTAT=RORLBLST(MSGID,"MS")
+66 DO MSG7STS^RORUTL05(MSGID,.RORXML,,7980000.002,.PARAMS,MSGSTAT)
End DoDot:3
+67 ;--- Close the registry section
+68 DO NTFXML("</REGISTRY>")
End DoDot:2
+69 ;--- E-mail footer
+70 DO BLD^DIALOG(7980000.026,.PARAMS,,"RORXML","S")
+71 ;--- Send the e-mail
+72 Begin DoDot:2
+73 NEW XMCHAN,XMDUZ,XMLOC,XMSUB,XMTEXT,XMY,XMZ
+74 SET XMDUZ=.5
SET XMY(EMAIL)=""
+75 SET XMSUB="ROR: HL7 PROBLEM"
+76 SET XMTEXT="RORXML("
+77 DO ^XMD
End DoDot:2
End DoDot:1
+78 QUIT
+79 ;
NTFXML(STR) ;
+1 SET RORXML($ORDER(RORXML(""),-1)+1)=STR
+2 QUIT
+3 ;
+4 ;***** UPDATES REGISTRY RECORDS AFTER SUCCESSFUL DATA TRANSMISSION
+5 ;
+6 ; BATCHID Internal HL7 batch ID
+7 ; BATCHDT Date/Time of the batch
+8 ;
+9 ; Return values:
+10 ; <0 Error code
+11 ; 0 Ok
+12 ;
UPDTRR(BATCHID,BATCHDT) ;
+1 NEW IEN,IENS,LBI,MSGID,PATIEN,REGIEN,RORBUF,RORFDA,RORMSG,TMP,XREF
+2 SET XREF=$$ROOT^DILFD(798)_"""AM"")"
+3 SET LBI=$LENGTH(BATCHID)
+4 ;===
+5 SET MSGID=BATCHID
+6 FOR
SET MSGID=$ORDER(@XREF@(MSGID))
if $EXTRACT(MSGID,1,LBI)'=BATCHID
QUIT
Begin DoDot:1
+7 SET IEN=0
+8 FOR
SET IEN=$ORDER(@XREF@(MSGID,IEN))
if IEN'>0
QUIT
Begin DoDot:2
+9 SET IENS=IEN_","
KILL RORBUF,RORFDA,RORMSG
+10 ;=== Load the registry record
+11 SET TMP=".01;.02;3;4;4.1;5;5.1;6;9.1;9.2;10"
+12 DO GETS^DIQ(798,IENS,TMP,"I","RORBUF","RORMSG")
+13 SET PATIEN=$GET(RORBUF(798,IENS,.01,"I"))
+14 IF $GET(DIERR)
DO DBS^RORERR("RORMSG",-9,,PATIEN,798,IENS)
QUIT
+15 SET REGIEN=+$GET(RORBUF(798,IENS,.02,"I"))
+16 ;
+17 ;=== Update record state only if the corresponding HL7 message
+18 ;=== was actually generated (check for fake Message ID)
+19 IF $PIECE($GET(RORBUF(798,IENS,10,"I")),"-",2)
SET RC=0
Begin DoDot:3
+20 ;--- Delete a record marked for deletion (only if the deletion
+21 ;--- date/time is earlier than the last message timestamp)
+22 IF $GET(RORBUF(798,IENS,3,"I"))=5
Begin DoDot:4
+23 if $GET(RORBUF(798,IENS,6,"I"))'<BATCHDT
QUIT
+24 NEW DA,DIK
SET RC=1
+25 SET DIK=$$ROOT^DILFD(798)
SET DA=IEN
DO ^DIK
+26 SET TMP=$$REGNAME^RORUTL01(REGIEN)
+27 DO LOG^RORERR(-90,,PATIEN,$PIECE(TMP,U))
End DoDot:4
QUIT
+28 ;--- Reset the UPDATE DEMOGRAPHICS flag if the demographic
+29 ;--- data was updated before the latest data extraction
+30 if $GET(RORBUF(798,IENS,4,"I"))
Begin DoDot:4
+31 if $GET(RORBUF(798,IENS,4.1,"I"))<BATCHDT
SET RORFDA(798,IENS,4)="@"
End DoDot:4
+32 ;--- Reset the UPDATE LOCAL REGISTRY DATA flag if the local
+33 ;--- data was updated before the latest data extraction
+34 if $GET(RORBUF(798,IENS,5,"I"))
Begin DoDot:4
+35 if $GET(RORBUF(798,IENS,5.1,"I"))<BATCHDT
SET RORFDA(798,IENS,5)="@"
End DoDot:4
End DoDot:3
if RC
QUIT
+36 ;
+37 ;=== Update extraction dates
+38 SET TMP=+$GET(RORBUF(798,IENS,9.2,"I"))
+39 if TMP>$GET(RORBUF(798,IENS,9.1))
SET RORFDA(798,IENS,9.1)=TMP
+40 ;=== Clear the message ID
+41 SET RORFDA(798,IENS,10)="@"
+42 ;=== Update the registry record (if necessary)
+43 if $DATA(RORFDA)>1
Begin DoDot:3
+44 DO FILE^DIE(,"RORFDA","RORMSG")
+45 if $GET(DIERR)
DO DBS^RORERR("RORMSG",-9,,PATIEN,798,IENS)
End DoDot:3
End DoDot:2
End DoDot:1
+46 ;===
+47 QUIT 0
