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

RAHLACK.m

Go to the documentation of this file.
  1. 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
  1. ; Based on information from incoming Ack, e-mail message is
  1. ; sent to Mail group: G.RAD HL7 MESSAGES
  1. ;
  1. ;Integration Agreements
  1. ;----------------------
  1. ;MSG^DIALOG(2050); $$GETAPP^HLCS2(2887); $$MSG^HLCSUTL(3099);^XMD(10070)
  1. ;
  1. MAIN ; Process incoming ACK, called from 2.4 protocols
  1. ;
  1. N CNT,ERR,ERROR,EXIT,GROUP,HLFS,HLCS,HLSCS,I,NUMBER,RAERR,SEG,X,Y
  1. D INIT,PROCESS,EXIT
  1. Q
  1. ;
  1. INIT ; initialize
  1. ;
  1. ;S DUZ(0)="@"
  1. ;
  1. S ERROR=0
  1. S HLFS=HL("FS"),HLCS=$E(HL("ECH"))
  1. S HLSCS=$E(HL("ECH"),4),HLREP=$E(HL("ECH"),2)
  1. Q
  1. ;
  1. PROCESS ; pull message text
  1. ;
  1. N SEG
  1. F X HLNEXT Q:HLQUIT'>0 S SEG=$P(HLNODE,HLFS) D:SEG'=""
  1. .D:"^MSH^MSA^ERR^"[(U_SEG_U) @SEG
  1. Q
  1. ;
  1. MSH ; -- MSH segment
  1. ;
  1. Q
  1. ;
  1. MSA ; -- MSA segment
  1. ;
  1. N CODE,DA,DIC,RAHLMA,RAMSA,RAMSG,X
  1. S CODE=$P(HLNODE,HLFS,2)
  1. I CODE="AE"!(CODE="AR") D
  1. .S ERROR=ERROR_U_$P(HLNODE,HLFS,4,99)
  1. .S RAERR("DIMSG",1)=CODE_" ACK Code received to the Message ID: "_$P(HLNODE,HLFS,3)
  1. .S RAMSA=$P(HLNODE,HLFS,3),RAMSG=$$MSG^HLCSUTL(RAMSA,"RAHLMA(1)")
  1. .I RAMSG>0 S RAERR("DIMSG",2)=RAHLMA(1,1)
  1. Q
  1. ;
  1. ERR ; -- ERR segment
  1. ;
  1. ; Set ERR segment handler here...
  1. Q
  1. ;
  1. EM(MID,ERROR,RAERR,XMSUB,XMY) ; error message
  1. ;
  1. N GROUP,RAMPG,RAX,XMDUZ,XMMG,XMTEXT,XMZ
  1. ;
  1. D MSG^DIALOG("AM",.RAX,80,"","RAERR")
  1. ;
  1. S RAX(.1)="HL7 message ID: "_$G(MID)
  1. S RAX(.2)="",RAX(.3)=$G(ERROR)
  1. S:$G(XMSUB)="" XMSUB="RAD ACK ERROR/WARNING/INFO"
  1. ;p154 - undefined HL("SAN") error, add $D check
  1. S RAMPG=$S($D(HL("SAN")):$P($$GETAPP^HLCS2(HL("SAN")),U,1),1:"") ;RAMPG="G.RAD HL7 MESSAGES"
  1. S:'$L(RAMPG) RAMPG="G.RAD HL7 MESSAGES"
  1. S XMY(RAMPG)="",XMDUZ=.5
  1. S XMTEXT="RAX("
  1. ;
  1. D ^XMD
  1. Q
  1. ;
  1. GSTATUS(HLRESLT,ED) ;
  1. Q:'$D(HLRESLT)
  1. N I,RAERR,ERROR,XMSUB
  1. S XMSUB="RAD HL7: Error in GENERATE^HLMA"
  1. S ERROR="For Event Driver: "_$P($G(^ORD(101,+$G(ED),0)),U)
  1. I +$P(HLRESLT,U,2)!$L($P(HLRESLT,U,3)) D
  1. .S RAERR(1)=$P(HLRESLT,U,2),RAERR(2)=$P(HLRESLT,U,3)
  1. .D EM(+HLRESLT,ERROR_">>"_HLRESLT_"<<",.RAERR,XMSUB_" single subscriber")
  1. .K RAERR
  1. S I=0 F S I=$O(HLRESLT(I)) Q:'I D:$L($P(HLRESLT(I),U,2))!$L($P(HLRESLT(I),U,3))
  1. .S RAERR(1)=$P(HLRESLT(I),U,2),RAERR(2)=$P(HLRESLT(I),U,3)
  1. .D EM(+HLRESLT(I),ERROR,.RAERR,XMSUB_" multi subscribers")
  1. .K RAERR
  1. Q
  1. ;
  1. ASTATUS(HLRESLT,MID,VNDR) ;ACK error
  1. ;
  1. Q:'$D(HLRESLT)
  1. N I,RAERR,ERROR,XMSUB
  1. S XMSUB="RAD HL7: Error in GENACK^HLMA1"
  1. S ERROR="ACK to:"_VNDR_" Message ID: "_MID
  1. I +$P(HLRESLT,U,2)!$L($P(HLRESLT,U,3)) D
  1. .S RAERR(1)=$P(HLRESLT,U,2),RAERR(2)=$P(HLRESLT,U,3)
  1. .D EM(+HLRESLT,ERROR_">>"_HLRESLT_"<<",.RAERR,XMSUB)
  1. .K RAERR
  1. Q
  1. EXIT ; cleanup, and quit.
  1. Q