- RAHLACK ;HISC/PAV - Process Appl Ack for (ORM) and (ORU) Msgs;14 Feb 2019 10:40 AM
- ;;5.0;Radiology/Nuclear Medicine;**47,154**;June 16, 2006;Build 1
- ; Based on information from incoming Ack, e-mail message is
- ; sent to Mail group: G.RAD HL7 MESSAGES
- ;
- ;Integration Agreements
- ;----------------------
- ;MSG^DIALOG(2050); $$GETAPP^HLCS2(2887); $$MSG^HLCSUTL(3099);^XMD(10070)
- ;
- MAIN ; Process incoming ACK, called from 2.4 protocols
- ;
- N CNT,ERR,ERROR,EXIT,GROUP,HLFS,HLCS,HLSCS,I,NUMBER,RAERR,SEG,X,Y
- D INIT,PROCESS,EXIT
- Q
- ;
- INIT ; initialize
- ;
- ;S DUZ(0)="@"
- ;
- S ERROR=0
- S HLFS=HL("FS"),HLCS=$E(HL("ECH"))
- S HLSCS=$E(HL("ECH"),4),HLREP=$E(HL("ECH"),2)
- Q
- ;
- PROCESS ; pull message text
- ;
- N SEG
- F X HLNEXT Q:HLQUIT'>0 S SEG=$P(HLNODE,HLFS) D:SEG'=""
- .D:"^MSH^MSA^ERR^"[(U_SEG_U) @SEG
- Q
- ;
- MSH ; -- MSH segment
- ;
- Q
- ;
- MSA ; -- MSA segment
- ;
- N CODE,DA,DIC,RAHLMA,RAMSA,RAMSG,X
- S CODE=$P(HLNODE,HLFS,2)
- I CODE="AE"!(CODE="AR") D
- .S ERROR=ERROR_U_$P(HLNODE,HLFS,4,99)
- .S RAERR("DIMSG",1)=CODE_" ACK Code received to the Message ID: "_$P(HLNODE,HLFS,3)
- .S RAMSA=$P(HLNODE,HLFS,3),RAMSG=$$MSG^HLCSUTL(RAMSA,"RAHLMA(1)")
- .I RAMSG>0 S RAERR("DIMSG",2)=RAHLMA(1,1)
- Q
- ;
- ERR ; -- ERR segment
- ;
- ; Set ERR segment handler here...
- Q
- ;
- EM(MID,ERROR,RAERR,XMSUB,XMY) ; error message
- ;
- N GROUP,RAMPG,RAX,XMDUZ,XMMG,XMTEXT,XMZ
- ;
- D MSG^DIALOG("AM",.RAX,80,"","RAERR")
- ;
- S RAX(.1)="HL7 message ID: "_$G(MID)
- S RAX(.2)="",RAX(.3)=$G(ERROR)
- S:$G(XMSUB)="" XMSUB="RAD ACK ERROR/WARNING/INFO"
- ;p154 - undefined HL("SAN") error, add $D check
- S RAMPG=$S($D(HL("SAN")):$P($$GETAPP^HLCS2(HL("SAN")),U,1),1:"") ;RAMPG="G.RAD HL7 MESSAGES"
- S:'$L(RAMPG) RAMPG="G.RAD HL7 MESSAGES"
- S XMY(RAMPG)="",XMDUZ=.5
- S XMTEXT="RAX("
- ;
- D ^XMD
- Q
- ;
- GSTATUS(HLRESLT,ED) ;
- Q:'$D(HLRESLT)
- N I,RAERR,ERROR,XMSUB
- S XMSUB="RAD HL7: Error in GENERATE^HLMA"
- S ERROR="For Event Driver: "_$P($G(^ORD(101,+$G(ED),0)),U)
- I +$P(HLRESLT,U,2)!$L($P(HLRESLT,U,3)) D
- .S RAERR(1)=$P(HLRESLT,U,2),RAERR(2)=$P(HLRESLT,U,3)
- .D EM(+HLRESLT,ERROR_">>"_HLRESLT_"<<",.RAERR,XMSUB_" single subscriber")
- .K RAERR
- S I=0 F S I=$O(HLRESLT(I)) Q:'I D:$L($P(HLRESLT(I),U,2))!$L($P(HLRESLT(I),U,3))
- .S RAERR(1)=$P(HLRESLT(I),U,2),RAERR(2)=$P(HLRESLT(I),U,3)
- .D EM(+HLRESLT(I),ERROR,.RAERR,XMSUB_" multi subscribers")
- .K RAERR
- Q
- ;
- ASTATUS(HLRESLT,MID,VNDR) ;ACK error
- ;
- Q:'$D(HLRESLT)
- N I,RAERR,ERROR,XMSUB
- S XMSUB="RAD HL7: Error in GENACK^HLMA1"
- S ERROR="ACK to:"_VNDR_" Message ID: "_MID
- I +$P(HLRESLT,U,2)!$L($P(HLRESLT,U,3)) D
- .S RAERR(1)=$P(HLRESLT,U,2),RAERR(2)=$P(HLRESLT,U,3)
- .D EM(+HLRESLT,ERROR_">>"_HLRESLT_"<<",.RAERR,XMSUB)
- .K RAERR
- Q
- EXIT ; cleanup, and quit.
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAHLACK 2781 printed Feb 19, 2025@00:01:29 Page 2
- RAHLACK ;HISC/PAV - Process Appl Ack for (ORM) and (ORU) Msgs;14 Feb 2019 10:40 AM
- +1 ;;5.0;Radiology/Nuclear Medicine;**47,154**;June 16, 2006;Build 1
- +2 ; Based on information from incoming Ack, e-mail message is
- +3 ; sent to Mail group: G.RAD HL7 MESSAGES
- +4 ;
- +5 ;Integration Agreements
- +6 ;----------------------
- +7 ;MSG^DIALOG(2050); $$GETAPP^HLCS2(2887); $$MSG^HLCSUTL(3099);^XMD(10070)
- +8 ;
- MAIN ; Process incoming ACK, called from 2.4 protocols
- +1 ;
- +2 NEW CNT,ERR,ERROR,EXIT,GROUP,HLFS,HLCS,HLSCS,I,NUMBER,RAERR,SEG,X,Y
- +3 DO INIT
- DO PROCESS
- DO EXIT
- +4 QUIT
- +5 ;
- INIT ; initialize
- +1 ;
- +2 ;S DUZ(0)="@"
- +3 ;
- +4 SET ERROR=0
- +5 SET HLFS=HL("FS")
- SET HLCS=$EXTRACT(HL("ECH"))
- +6 SET HLSCS=$EXTRACT(HL("ECH"),4)
- SET HLREP=$EXTRACT(HL("ECH"),2)
- +7 QUIT
- +8 ;
- PROCESS ; pull message text
- +1 ;
- +2 NEW SEG
- +3 FOR
- XECUTE HLNEXT
- if HLQUIT'>0
- QUIT
- SET SEG=$PIECE(HLNODE,HLFS)
- if SEG'=""
- Begin DoDot:1
- +4 if "^MSH^MSA^ERR^"[(U_SEG_U)
- DO @SEG
- End DoDot:1
- +5 QUIT
- +6 ;
- MSH ; -- MSH segment
- +1 ;
- +2 QUIT
- +3 ;
- MSA ; -- MSA segment
- +1 ;
- +2 NEW CODE,DA,DIC,RAHLMA,RAMSA,RAMSG,X
- +3 SET CODE=$PIECE(HLNODE,HLFS,2)
- +4 IF CODE="AE"!(CODE="AR")
- Begin DoDot:1
- +5 SET ERROR=ERROR_U_$PIECE(HLNODE,HLFS,4,99)
- +6 SET RAERR("DIMSG",1)=CODE_" ACK Code received to the Message ID: "_$PIECE(HLNODE,HLFS,3)
- +7 SET RAMSA=$PIECE(HLNODE,HLFS,3)
- SET RAMSG=$$MSG^HLCSUTL(RAMSA,"RAHLMA(1)")
- +8 IF RAMSG>0
- SET RAERR("DIMSG",2)=RAHLMA(1,1)
- End DoDot:1
- +9 QUIT
- +10 ;
- ERR ; -- ERR segment
- +1 ;
- +2 ; Set ERR segment handler here...
- +3 QUIT
- +4 ;
- EM(MID,ERROR,RAERR,XMSUB,XMY) ; error message
- +1 ;
- +2 NEW GROUP,RAMPG,RAX,XMDUZ,XMMG,XMTEXT,XMZ
- +3 ;
- +4 DO MSG^DIALOG("AM",.RAX,80,"","RAERR")
- +5 ;
- +6 SET RAX(.1)="HL7 message ID: "_$GET(MID)
- +7 SET RAX(.2)=""
- SET RAX(.3)=$GET(ERROR)
- +8 if $GET(XMSUB)=""
- SET XMSUB="RAD ACK ERROR/WARNING/INFO"
- +9 ;p154 - undefined HL("SAN") error, add $D check
- +10 ;RAMPG="G.RAD HL7 MESSAGES"
- SET RAMPG=$SELECT($DATA(HL("SAN")):$PIECE($$GETAPP^HLCS2(HL("SAN")),U,1),1:"")
- +11 if '$LENGTH(RAMPG)
- SET RAMPG="G.RAD HL7 MESSAGES"
- +12 SET XMY(RAMPG)=""
- SET XMDUZ=.5
- +13 SET XMTEXT="RAX("
- +14 ;
- +15 DO ^XMD
- +16 QUIT
- +17 ;
- GSTATUS(HLRESLT,ED) ;
- +1 if '$DATA(HLRESLT)
- QUIT
- +2 NEW I,RAERR,ERROR,XMSUB
- +3 SET XMSUB="RAD HL7: Error in GENERATE^HLMA"
- +4 SET ERROR="For Event Driver: "_$PIECE($GET(^ORD(101,+$GET(ED),0)),U)
- +5 IF +$PIECE(HLRESLT,U,2)!$LENGTH($PIECE(HLRESLT,U,3))
- Begin DoDot:1
- +6 SET RAERR(1)=$PIECE(HLRESLT,U,2)
- SET RAERR(2)=$PIECE(HLRESLT,U,3)
- +7 DO EM(+HLRESLT,ERROR_">>"_HLRESLT_"<<",.RAERR,XMSUB_" single subscriber")
- +8 KILL RAERR
- End DoDot:1
- +9 SET I=0
- FOR
- SET I=$ORDER(HLRESLT(I))
- if 'I
- QUIT
- if $LENGTH($PIECE(HLRESLT(I),U,2))!$LENGTH($PIECE(HLRESLT(I),U,3))
- Begin DoDot:1
- +10 SET RAERR(1)=$PIECE(HLRESLT(I),U,2)
- SET RAERR(2)=$PIECE(HLRESLT(I),U,3)
- +11 DO EM(+HLRESLT(I),ERROR,.RAERR,XMSUB_" multi subscribers")
- +12 KILL RAERR
- End DoDot:1
- +13 QUIT
- +14 ;
- ASTATUS(HLRESLT,MID,VNDR) ;ACK error
- +1 ;
- +2 if '$DATA(HLRESLT)
- QUIT
- +3 NEW I,RAERR,ERROR,XMSUB
- +4 SET XMSUB="RAD HL7: Error in GENACK^HLMA1"
- +5 SET ERROR="ACK to:"_VNDR_" Message ID: "_MID
- +6 IF +$PIECE(HLRESLT,U,2)!$LENGTH($PIECE(HLRESLT,U,3))
- Begin DoDot:1
- +7 SET RAERR(1)=$PIECE(HLRESLT,U,2)
- SET RAERR(2)=$PIECE(HLRESLT,U,3)
- +8 DO EM(+HLRESLT,ERROR_">>"_HLRESLT_"<<",.RAERR,XMSUB)
- +9 KILL RAERR
- End DoDot:1
- +10 QUIT
- EXIT ; cleanup, and quit.
- +1 QUIT