94 lines
1.3 KiB
Mathematica
94 lines
1.3 KiB
Mathematica
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
|
|
;
|