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

XUMFMD5.m

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