XUMFMD5 ;ISS/RAM - MD5 Handler ;06/28/00 ;;8.0;KERNEL;**407**;Jul 10, 1995;Build 8 ; ; Q ; MAIN ; -- main ; N ERROR,CNT,HLFS,HLCS,MFI,QRD ; ; D INIT,PROCESS,MFR,SEND,EXIT ; Q ; INIT ; -- initialize ; K ^TMP("HLA",$J) ; S ERROR=0,CNT=1 ; S HLFS=HL("FS"),HLCS=$E(HL("ECH")),HLSCS=$E(HL("ECH"),4) ; Q ; PROCESS ; -- pull message text ; F X HLNEXT Q:HLQUIT'>0 D .Q:$P(HLNODE,HLFS)="" .Q:"^MSH^MSA^QRD^"'[(U_$P(HLNODE,HLFS)_U) .D @($P(HLNODE,HLFS)) ; Q ; MSH ; -- MSH segment ; Q ; QRD ; -- QRD segment ; S MFI=$P(HLNODE,HLFS,10) I MFI="" S ERROR="1^MFI not resolved HLNODE: "_$TR(HLNODE,HLFS,"#") Q ; D EN^XUMF5I(MFI) ; S QRD=HLNODE ; Q ; MFR ; -- response ; D MSA,QRD1 ; Q ; MSA ; -- Acknowledgement ; N X S X="MSA"_HLFS_$S(ERROR:"AE",1:"AA")_HLFS_HL("MID")_HLFS_$P(ERROR,U,2) S ^TMP("HLA",$J,CNT)=X S CNT=CNT+1 ; Q ; QRD1 ; -- query definition segment ; S ^TMP("HLA",$J,CNT)=QRD S CNT=CNT+1 ; Q ; SEND ; -- send HL7 message ; S HLP("PRIORITY")="I" D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"GM",1,.HLRESLT) ; ; check for error I ($P($G(HLRESLT),U,3)'="") D Q .S ERROR=1_U_$P(HLRESLT,HLFS,3)_U_$P(HLRESLT,HLFS,2)_U_$P(HLRESLT,U) ; ; successful call, message ID returned S ERROR="0^"_$P($G(HLRESLT),U,1) ; Q ; EXIT ; -- exit ; D CLEAN^DILF ; K ^TMP("HLA",$J) ; Q ;