SDPMHLA ; BPFO/JRC - HL 7 ACKNOWLEDGEMENT HANDLER ; 3/30/04 11:20am
;;5.3;SCHEDULING;**313**;AUG 13, 1993
;
;====================================================================
;Additional Performance Monitors process acknowledgement routine
;
;This routine takes and enhanced mode acknowledgement message
;from Austin passes it to HL7 and it matches it to the originating
;message from the information contained in the message ID.
;
;Input
; Acknowledgment message from AAC
;Output
; Bulletin to 'SD PM NOTIFICATION TIU' when a rejection message
; is found
;====================================================================
ACKR01 ; Receives the ACK messages
; Input : All variables set by the HL7 package
N SDACK,SDPARAM,HLNODE,I,X
;Get message text
S ^TMP("SDPRUACK",$H)="START PROCESS"
F I=1:1 X HLNEXT Q:(HLQUIT'>0) D
. S SDMSG(I,1)=HLNODE
. ; Check for segment length greater than 245
. S X=0 F S X=+$O(HLNODE(X)) Q:('X) S SDMSG(I,(X+1))=HLNODE(X)
;
M ^TMP("SDPRUACK",$H,"HL")=SDMSG
; Analyze the message and take appropriate response
; Quit if there is no valid message header
Q:$P(SDMSG(1,1),"^")'="MSH"
;
S X=1,SDPARAM=""
F S X=+$O(SDMSG(X)) Q:('X) D
. I $P(SDMSG(X,1),"^")="MSA" D
.. D PROCESS(SDMSG(X,1),.SDPARAM)
Q
;
NOTIFY ; Task sending of response notification
Q:$O(SDPARAM(""))=""
D SENDIT
Q
SENDIT ; Notify mail group that a error message was received
; Input : MSGARY() - Array containing HL7 Message received
; Ouput : None
N MSGTXT,XMY,XMTEXT,XMDUZ,XMDT,XMZ,LINE,XMB,XMCHAN,XMSUB
;
S MSGTEXT(1)=" "
S MSGTEXT(2)="TIU's Performance Indicator National Rollup encountered an error while"
S MSGTEXT(3)="processing HL7 message '"_MSGID_"'. If necessary, use option 'Performance"
S MSGTEXT(4)="Monitor Retransmit Report (AAC)' to retransmit it."
S MSGTEXT(5)=" "
S MSGTEXT(6)="Encounter date range: "_$$FMTE^XLFDT(STADATE,1)_" to "_$$FMTE^XLFDT(ENDDATE,1)
S MSGTEXT(7)=" "
S MSGTEXT(8)="Please contact Austin Automation Center's help desk."
S XMSUB="SD ENC PERF MON Error Message"
S XMTEXT="MSGTEXT("
S XMY("G.SD PM NOTIFICATION TIU")=""
S XMCHAN=1
S XMDUZ="Performance Indicator"
;S XMB="SDPM REJECT"
S XMDT=DT
D ^XMD
Q
;
PROCESS(SDMSG,SDPARAM) ;Process incoming acknowledgment
;
N ACK,MSGID,PMSG,MNODE,STADATE,ENDDATE
;
Q:$G(SDMSG)']""
;
S ACK=$P(SDMSG,HL("FS"),2) ; Get acknowledgment code
; If the acknowledgementcode is AA, then do not send notification
Q:ACK="AA"
; Get outgoing message ID
S MSGID=$P(SDMSG,HL("FS"),3)
S MSGID=$E(MSGID,4,$L(MSGID))
; Set rejection message for SDPM acknowledgement message
S:'(ACK="AA") SDPARAM(4)=$S(ACK="AE":"Application Error",ACK="AR":"Application Reject",1:"Unknown Error")
; Retrieve HL7 parent message ID
S PMSG=$P($G(^HL(772,MSGID,0)),HL("FS"),8) ;IA # 4069
; Retrieve HL7 message 'OBR' node
S MNODE=^HL(772,MSGID,"IN",1,0) ;IA # 4069
; Retrieve date range
S RANGE=$P($G(^HL(772,MSGID,"IN",1,0)),HL("FS"),28) ;IA # 4069
S STADATE=$P($G(RANGE),"~",4),ENDDATE=$P($G(RANGE),"~",5)
; Convert date from HL7 to FM format
S STADATE=$$HL7TFM^XLFDT(STADATE),ENDDATE=$$HL7TFM^XLFDT(ENDDATE)
D NOTIFY
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDPMHLA 3255 printed Apr 09, 2024@21:59:04 Page 2
SDPMHLA ; BPFO/JRC - HL 7 ACKNOWLEDGEMENT HANDLER ; 3/30/04 11:20am
+1 ;;5.3;SCHEDULING;**313**;AUG 13, 1993
+2 ;
+3 ;====================================================================
+4 ;Additional Performance Monitors process acknowledgement routine
+5 ;
+6 ;This routine takes and enhanced mode acknowledgement message
+7 ;from Austin passes it to HL7 and it matches it to the originating
+8 ;message from the information contained in the message ID.
+9 ;
+10 ;Input
+11 ; Acknowledgment message from AAC
+12 ;Output
+13 ; Bulletin to 'SD PM NOTIFICATION TIU' when a rejection message
+14 ; is found
+15 ;====================================================================
ACKR01 ; Receives the ACK messages
+1 ; Input : All variables set by the HL7 package
+2 NEW SDACK,SDPARAM,HLNODE,I,X
+3 ;Get message text
+4 SET ^TMP("SDPRUACK",$HOROLOG)="START PROCESS"
+5 FOR I=1:1
XECUTE HLNEXT
if (HLQUIT'>0)
QUIT
Begin DoDot:1
+6 SET SDMSG(I,1)=HLNODE
+7 ; Check for segment length greater than 245
+8 SET X=0
FOR
SET X=+$ORDER(HLNODE(X))
if ('X)
QUIT
SET SDMSG(I,(X+1))=HLNODE(X)
End DoDot:1
+9 ;
+10 MERGE ^TMP("SDPRUACK",$HOROLOG,"HL")=SDMSG
+11 ; Analyze the message and take appropriate response
+12 ; Quit if there is no valid message header
+13 if $PIECE(SDMSG(1,1),"^")'="MSH"
QUIT
+14 ;
+15 SET X=1
SET SDPARAM=""
+16 FOR
SET X=+$ORDER(SDMSG(X))
if ('X)
QUIT
Begin DoDot:1
+17 IF $PIECE(SDMSG(X,1),"^")="MSA"
Begin DoDot:2
+18 DO PROCESS(SDMSG(X,1),.SDPARAM)
End DoDot:2
End DoDot:1
+19 QUIT
+20 ;
NOTIFY ; Task sending of response notification
+1 if $ORDER(SDPARAM(""))=""
QUIT
+2 DO SENDIT
+3 QUIT
SENDIT ; Notify mail group that a error message was received
+1 ; Input : MSGARY() - Array containing HL7 Message received
+2 ; Ouput : None
+3 NEW MSGTXT,XMY,XMTEXT,XMDUZ,XMDT,XMZ,LINE,XMB,XMCHAN,XMSUB
+4 ;
+5 SET MSGTEXT(1)=" "
+6 SET MSGTEXT(2)="TIU's Performance Indicator National Rollup encountered an error while"
+7 SET MSGTEXT(3)="processing HL7 message '"_MSGID_"'. If necessary, use option 'Performance"
+8 SET MSGTEXT(4)="Monitor Retransmit Report (AAC)' to retransmit it."
+9 SET MSGTEXT(5)=" "
+10 SET MSGTEXT(6)="Encounter date range: "_$$FMTE^XLFDT(STADATE,1)_" to "_$$FMTE^XLFDT(ENDDATE,1)
+11 SET MSGTEXT(7)=" "
+12 SET MSGTEXT(8)="Please contact Austin Automation Center's help desk."
+13 SET XMSUB="SD ENC PERF MON Error Message"
+14 SET XMTEXT="MSGTEXT("
+15 SET XMY("G.SD PM NOTIFICATION TIU")=""
+16 SET XMCHAN=1
+17 SET XMDUZ="Performance Indicator"
+18 ;S XMB="SDPM REJECT"
+19 SET XMDT=DT
+20 DO ^XMD
+21 QUIT
+22 ;
PROCESS(SDMSG,SDPARAM) ;Process incoming acknowledgment
+1 ;
+2 NEW ACK,MSGID,PMSG,MNODE,STADATE,ENDDATE
+3 ;
+4 if $GET(SDMSG)']""
QUIT
+5 ;
+6 ; Get acknowledgment code
SET ACK=$PIECE(SDMSG,HL("FS"),2)
+7 ; If the acknowledgementcode is AA, then do not send notification
+8 if ACK="AA"
QUIT
+9 ; Get outgoing message ID
+10 SET MSGID=$PIECE(SDMSG,HL("FS"),3)
+11 SET MSGID=$EXTRACT(MSGID,4,$LENGTH(MSGID))
+12 ; Set rejection message for SDPM acknowledgement message
+13 if '(ACK="AA")
SET SDPARAM(4)=$SELECT(ACK="AE":"Application Error",ACK="AR":"Application Reject",1:"Unknown Error")
+14 ; Retrieve HL7 parent message ID
+15 ;IA # 4069
SET PMSG=$PIECE($GET(^HL(772,MSGID,0)),HL("FS"),8)
+16 ; Retrieve HL7 message 'OBR' node
+17 ;IA # 4069
SET MNODE=^HL(772,MSGID,"IN",1,0)
+18 ; Retrieve date range
+19 ;IA # 4069
SET RANGE=$PIECE($GET(^HL(772,MSGID,"IN",1,0)),HL("FS"),28)
+20 SET STADATE=$PIECE($GET(RANGE),"~",4)
SET ENDDATE=$PIECE($GET(RANGE),"~",5)
+21 ; Convert date from HL7 to FM format
+22 SET STADATE=$$HL7TFM^XLFDT(STADATE)
SET ENDDATE=$$HL7TFM^XLFDT(ENDDATE)
+23 DO NOTIFY
+24 QUIT
