Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ROR11

ROR11.m

Go to the documentation of this file. 
  1. ROR11 ;HCIOFO/SG - NIGHTLY TASK UTILITIES ; 12/7/05 9:40am
  1.  ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
  1.  ;
  1.  ; RORLBLST ------------ LIST OF LATEST HL7 MESSAGES
  1.  ;
  1.  ; RORLBLST(
  1.  ;   MsgID,              Internal Batch ID
  1.  ;     "MS")             Message Status (see $$MSGSTAT^HLUTIL)
  1.  ;                         ^01: Status Code
  1.  ;                         ^02: Status Updated
  1.  ;                         ^03: Error Message
  1.  ;                         ^04: Error Type pointer
  1.  ;                         ^05: Queue Position or Number of Retries
  1.  ;                         ^06: Open Failed
  1.  ;                         ^07: ACK Timeout
  1.  ;     "RL",
  1.  ;       RegIEN)         IENS of the message reference in the
  1.  ;                       registry parameters (sub-file #798.122)
  1.  ;
  1.  ;   "N",                Created and used by the NOTIFY^ROR11
  1.  ;     EMail,
  1.  ;       RegName)        RegIEN
  1.  ;
  1.  ;   "RM",
  1.  ;     RegIEN,           ""
  1.  ;       MsgID)          ""
  1.  ;
  1.  Q
  1.  ;
  1.  ;***** ADDS THE HL7 BATCH MESSAGE TO THE LIST
  1.  ;
  1.  ; MSGID         Batch HL7 Message Control ID
  1.  ; IENS          IENS of the message reference in the reigstry
  1.  ;               parameters (sub-file #798.122)
  1.  ; IBID          Internal Batch ID
  1.  ; DATE          Date/Time of the batch
  1.  ;
  1. ADDMSG(MSGID,IENS,IBID,DATE) ;
  1.  N REGIEN  S REGIEN=$P(IENS,",",2)
  1.  D:'$D(RORLBLST(MSGID))
  1.  . S RORLBLST(MSGID,"MS")=$$MSGSTAT^HLUTIL(MSGID)
  1.  . S RORLBLST(MSGID,"DT")=DATE
  1.  . S RORLBLST(MSGID)=IBID
  1.  S RORLBLST(MSGID,"RL",REGIEN)=IENS
  1.  S RORLBLST("RM",REGIEN,MSGID)=""
  1.  S RORLBLST("RM",REGIEN)=""
  1.  Q
  1.  ;
  1.  ;***** REMOVES THE HL7 BATCH MESSAGE FROM THE LIST
  1.  ;
  1.  ; MSGID         Batch HL7 Message Control ID
  1.  ; [.FDA]        Reference to the FDA arrays that will be updated
  1.  ;               to remove the references to the message
  1.  ;
  1. DELMSG(MSGID,FDA) ;
  1.  N IENS,REGIEN  S REGIEN=""
  1.  F  S REGIEN=$O(RORLBLST(MSGID,"RL",REGIEN))  Q:REGIEN=""  D
  1.  . S IENS=$P(RORLBLST(MSGID,"RL",REGIEN),U)
  1.  . S:IENS'="" FDA(798.122,IENS,.01)="@"
  1.  . K RORLBLST("RM",REGIEN,MSGID)
  1.  K RORLBLST(MSGID)
  1.  Q
  1.  ;
  1.  ;***** NOTIFIES THE AAC AND LOCAL COORDINATORS
  1. NOTIFY() ;
  1.  Q:$D(RORLBLST("RM"))<10
  1.  N ALNOR,EMAIL,IENS,MSGID,NOR,PARAMS,REGIEN,REGNAME,RORBUF,RORMSG,RORTXT,RORXML,TMP
  1.  K RORLBLST("N")
  1.  ;
  1.  ;=== Send local alerts and generate the notification list
  1.  S REGIEN=0
  1.  F  S REGIEN=$O(RORLBLST("RM",REGIEN))  Q:REGIEN'>0  D
  1.  . K RORBUF,RORMSG,RORTXT  S IENS=REGIEN_","
  1.  . ;--- Load the notification parameters
  1.  . D GETS^DIQ(798.1,IENS,".01;13.2;13.3;19.3",,"RORBUF","RORMSG")
  1.  . I $G(DIERR)  D DBS^RORERR("RORMSG",-9,,,798.1,IENS)  Q
  1.  . ;--- Check if the notification should be sent
  1.  . S ALNOR=+$G(RORBUF(798.1,IENS,13.2)) ; ALERT FREQUENCY
  1.  . S NOR=+$G(RORBUF(798.1,IENS,19.3))   ; HL7 ATTEMPT COUNTER
  1.  . Q:$S(ALNOR'>0:1,1:NOR#ALNOR)
  1.  . ;---
  1.  . S REGNAME=$G(RORBUF(798.1,IENS,.01)) ; Registry Name
  1.  . S EMAIL=$G(RORBUF(798.1,IENS,13.3))  ; Notification E-mail
  1.  . S PARAMS("REGISTRY")=REGNAME
  1.  . S PARAMS("NOR")=NOR
  1.  . ;--- Error message header
  1.  . D BLD^DIALOG(7980000.023,.PARAMS,,"RORTXT","S")
  1.  . ;--- Append the list of unsent HL7 messages
  1.  . S MSGID=""
  1.  . F  S MSGID=$O(RORLBLST("RM",REGIEN,MSGID))  Q:MSGID=""  D
  1.  . . S MSGSTAT=RORLBLST(MSGID,"MS")
  1.  . . S RORTXT($O(RORTXT(""),-1)+1)=""
  1.  . . D MSG7STS^RORUTL05(MSGID,.RORTXT,,7980000.004,.PARAMS,MSGSTAT)
  1.  . ;--- Error message footer
  1.  . D BLD^DIALOG(7980000.024,.PARAMS,,"RORTXT")
  1.  . ;--- Record the error message
  1.  . D LOG^RORERR(-67,.RORTXT,,NOR)
  1.  . ;--- Notify local staff
  1.  . S TMP=REGNAME_U_NOR
  1.  . D ALERT^RORUTL01(REGNAME,-67,"ALERT^ROR10",TMP,,NOR)
  1.  . ;--- Update the national notification list
  1.  . D:$$CCRNTFY^RORUTL05(REGIEN)
  1.  . . S:EMAIL'="" RORLBLST("N",EMAIL,REGNAME)=REGIEN
  1.  ;
  1.  ;=== Get station name and number
  1.  S TMP=$$SITE^RORUTL03()
  1.  S PARAMS("STNAME")=$P(TMP,U,2)
  1.  S PARAMS("STNUM")=$P(TMP,U)
  1.  ;
  1.  ;=== Generate notification e-mails
  1.  S EMAIL=""
  1.  F  S EMAIL=$O(RORLBLST("N",EMAIL))  Q:EMAIL=""  D
  1.  . K RORXML
  1.  . ;--- E-mail header
  1.  . D BLD^DIALOG(7980000.025,.PARAMS,,"RORXML","S")
  1.  . ;--- Process affected registries
  1.  . S REGNAME=""
  1.  . F  S REGNAME=$O(RORLBLST("N",EMAIL,REGNAME))  Q:REGNAME=""  D
  1.  . . S REGIEN=+RORLBLST("N",EMAIL,REGNAME)
  1.  . . S PARAMS("REGISTRY")=REGNAME
  1.  . . S PARAMS("NOR")=NOR
  1.  . . ;--- Append registry section
  1.  . . D NTFXML("<REGISTRY>")
  1.  . . D NTFXML("<NAME>"_REGNAME_"</NAME>")
  1.  . . S TMP=$P($$REGNAME^RORUTL01(REGIEN),U,2)
  1.  . . D NTFXML("<DESCRIPTION>"_TMP_"</DESCRIPTION>")
  1.  . . ;--- Append message list
  1.  . . S MSGID=""
  1.  . . F  S MSGID=$O(RORLBLST("RM",REGIEN,MSGID))  Q:MSGID=""  D
  1.  . . . S MSGSTAT=RORLBLST(MSGID,"MS")
  1.  . . . D MSG7STS^RORUTL05(MSGID,.RORXML,,7980000.002,.PARAMS,MSGSTAT)
  1.  . . ;--- Close the registry section
  1.  . . D NTFXML("</REGISTRY>")
  1.  . ;--- E-mail footer
  1.  . D BLD^DIALOG(7980000.026,.PARAMS,,"RORXML","S")
  1.  . ;--- Send the e-mail
  1.  . D
  1.  . . N XMCHAN,XMDUZ,XMLOC,XMSUB,XMTEXT,XMY,XMZ
  1.  . . S XMDUZ=.5,XMY(EMAIL)=""
  1.  . . S XMSUB="ROR: HL7 PROBLEM"
  1.  . . S XMTEXT="RORXML("
  1.  . . D ^XMD
  1.  Q
  1.  ;
  1. NTFXML(STR) ;
  1.  S RORXML($O(RORXML(""),-1)+1)=STR
  1.  Q
  1.  ;
  1.  ;***** UPDATES REGISTRY RECORDS AFTER SUCCESSFUL DATA TRANSMISSION
  1.  ;
  1.  ; BATCHID       Internal HL7 batch ID
  1.  ; BATCHDT       Date/Time of the batch
  1.  ;
  1.  ; Return values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;
  1. UPDTRR(BATCHID,BATCHDT) ;
  1.  N IEN,IENS,LBI,MSGID,PATIEN,REGIEN,RORBUF,RORFDA,RORMSG,TMP,XREF
  1.  S XREF=$$ROOT^DILFD(798)_"""AM"")"
  1.  S LBI=$L(BATCHID)
  1.  ;===
  1.  S MSGID=BATCHID
  1.  F  S MSGID=$O(@XREF@(MSGID))  Q:$E(MSGID,1,LBI)'=BATCHID  D
  1.  . S IEN=0
  1.  . F  S IEN=$O(@XREF@(MSGID,IEN))  Q:IEN'>0  D
  1.  . . S IENS=IEN_","  K RORBUF,RORFDA,RORMSG
  1.  . . ;=== Load the registry record
  1.  . . S TMP=".01;.02;3;4;4.1;5;5.1;6;9.1;9.2;10"
  1.  . . D GETS^DIQ(798,IENS,TMP,"I","RORBUF","RORMSG")
  1.  . . S PATIEN=$G(RORBUF(798,IENS,.01,"I"))
  1.  . . I $G(DIERR)  D DBS^RORERR("RORMSG",-9,,PATIEN,798,IENS)  Q
  1.  . . S REGIEN=+$G(RORBUF(798,IENS,.02,"I"))
  1.  . . ;
  1.  . . ;=== Update record state only if the corresponding HL7 message
  1.  . . ;=== was actually generated (check for fake Message ID)
  1.  . . I $P($G(RORBUF(798,IENS,10,"I")),"-",2)  S RC=0  D  Q:RC
  1.  . . . ;--- Delete a record marked for deletion (only if the deletion
  1.  . . . ;--- date/time is earlier than the last message timestamp)
  1.  . . . I $G(RORBUF(798,IENS,3,"I"))=5  D  Q
  1.  . . . . Q:$G(RORBUF(798,IENS,6,"I"))'<BATCHDT
  1.  . . . . N DA,DIK  S RC=1
  1.  . . . . S DIK=$$ROOT^DILFD(798),DA=IEN  D ^DIK
  1.  . . . . S TMP=$$REGNAME^RORUTL01(REGIEN)
  1.  . . . . D LOG^RORERR(-90,,PATIEN,$P(TMP,U))
  1.  . . . ;--- Reset the UPDATE DEMOGRAPHICS flag if the demographic
  1.  . . . ;--- data was updated before the latest data extraction
  1.  . . . D:$G(RORBUF(798,IENS,4,"I"))
  1.  . . . . S:$G(RORBUF(798,IENS,4.1,"I"))<BATCHDT RORFDA(798,IENS,4)="@"
  1.  . . . ;--- Reset the UPDATE LOCAL REGISTRY DATA flag if the local
  1.  . . . ;--- data was updated before the latest data extraction
  1.  . . . D:$G(RORBUF(798,IENS,5,"I"))
  1.  . . . . S:$G(RORBUF(798,IENS,5.1,"I"))<BATCHDT RORFDA(798,IENS,5)="@"
  1.  . . ;
  1.  . . ;=== Update extraction dates
  1.  . . S TMP=+$G(RORBUF(798,IENS,9.2,"I"))
  1.  . . S:TMP>$G(RORBUF(798,IENS,9.1)) RORFDA(798,IENS,9.1)=TMP
  1.  . . ;=== Clear the message ID
  1.  . . S RORFDA(798,IENS,10)="@"
  1.  . . ;=== Update the registry record (if necessary)
  1.  . . D:$D(RORFDA)>1
  1.  . . . D FILE^DIE(,"RORFDA","RORMSG")
  1.  . . . D:$G(DIERR) DBS^RORERR("RORMSG",-9,,PATIEN,798,IENS)
  1.  ;===
  1.  Q 0