| 1 | XUMFMD5 ;ISS/RAM - MD5 Handler ;06/28/00
|
|---|
| 2 | ;;8.0;KERNEL;**407**;Jul 10, 1995;Build 8
|
|---|
| 3 | ;
|
|---|
| 4 | ;
|
|---|
| 5 | Q
|
|---|
| 6 | ;
|
|---|
| 7 | MAIN ; -- main
|
|---|
| 8 | ;
|
|---|
| 9 | N ERROR,CNT,HLFS,HLCS,MFI,QRD
|
|---|
| 10 | ;
|
|---|
| 11 | ;
|
|---|
| 12 | D INIT,PROCESS,MFR,SEND,EXIT
|
|---|
| 13 | ;
|
|---|
| 14 | Q
|
|---|
| 15 | ;
|
|---|
| 16 | INIT ; -- initialize
|
|---|
| 17 | ;
|
|---|
| 18 | K ^TMP("HLA",$J)
|
|---|
| 19 | ;
|
|---|
| 20 | S ERROR=0,CNT=1
|
|---|
| 21 | ;
|
|---|
| 22 | S HLFS=HL("FS"),HLCS=$E(HL("ECH")),HLSCS=$E(HL("ECH"),4)
|
|---|
| 23 | ;
|
|---|
| 24 | Q
|
|---|
| 25 | ;
|
|---|
| 26 | PROCESS ; -- pull message text
|
|---|
| 27 | ;
|
|---|
| 28 | F X HLNEXT Q:HLQUIT'>0 D
|
|---|
| 29 | .Q:$P(HLNODE,HLFS)=""
|
|---|
| 30 | .Q:"^MSH^MSA^QRD^"'[(U_$P(HLNODE,HLFS)_U)
|
|---|
| 31 | .D @($P(HLNODE,HLFS))
|
|---|
| 32 | ;
|
|---|
| 33 | Q
|
|---|
| 34 | ;
|
|---|
| 35 | MSH ; -- MSH segment
|
|---|
| 36 | ;
|
|---|
| 37 | Q
|
|---|
| 38 | ;
|
|---|
| 39 | QRD ; -- QRD segment
|
|---|
| 40 | ;
|
|---|
| 41 | S MFI=$P(HLNODE,HLFS,10)
|
|---|
| 42 | I MFI="" S ERROR="1^MFI not resolved HLNODE: "_$TR(HLNODE,HLFS,"#") Q
|
|---|
| 43 | ;
|
|---|
| 44 | D EN^XUMF5I(MFI)
|
|---|
| 45 | ;
|
|---|
| 46 | S QRD=HLNODE
|
|---|
| 47 | ;
|
|---|
| 48 | Q
|
|---|
| 49 | ;
|
|---|
| 50 | MFR ; -- response
|
|---|
| 51 | ;
|
|---|
| 52 | D MSA,QRD1
|
|---|
| 53 | ;
|
|---|
| 54 | Q
|
|---|
| 55 | ;
|
|---|
| 56 | MSA ; -- Acknowledgement
|
|---|
| 57 | ;
|
|---|
| 58 | N X
|
|---|
| 59 | S X="MSA"_HLFS_$S(ERROR:"AE",1:"AA")_HLFS_HL("MID")_HLFS_$P(ERROR,U,2)
|
|---|
| 60 | S ^TMP("HLA",$J,CNT)=X
|
|---|
| 61 | S CNT=CNT+1
|
|---|
| 62 | ;
|
|---|
| 63 | Q
|
|---|
| 64 | ;
|
|---|
| 65 | QRD1 ; -- query definition segment
|
|---|
| 66 | ;
|
|---|
| 67 | S ^TMP("HLA",$J,CNT)=QRD
|
|---|
| 68 | S CNT=CNT+1
|
|---|
| 69 | ;
|
|---|
| 70 | Q
|
|---|
| 71 | ;
|
|---|
| 72 | SEND ; -- send HL7 message
|
|---|
| 73 | ;
|
|---|
| 74 | S HLP("PRIORITY")="I"
|
|---|
| 75 | D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"GM",1,.HLRESLT)
|
|---|
| 76 | ;
|
|---|
| 77 | ; check for error
|
|---|
| 78 | I ($P($G(HLRESLT),U,3)'="") D Q
|
|---|
| 79 | .S ERROR=1_U_$P(HLRESLT,HLFS,3)_U_$P(HLRESLT,HLFS,2)_U_$P(HLRESLT,U)
|
|---|
| 80 | ;
|
|---|
| 81 | ; successful call, message ID returned
|
|---|
| 82 | S ERROR="0^"_$P($G(HLRESLT),U,1)
|
|---|
| 83 | ;
|
|---|
| 84 | Q
|
|---|
| 85 | ;
|
|---|
| 86 | EXIT ; -- exit
|
|---|
| 87 | ;
|
|---|
| 88 | D CLEAN^DILF
|
|---|
| 89 | ;
|
|---|
| 90 | K ^TMP("HLA",$J)
|
|---|
| 91 | ;
|
|---|
| 92 | Q
|
|---|
| 93 | ;
|
|---|
