- 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
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUMFMD5 1442 printed Feb 18, 2025@23:37:19 Page 2
- XUMFMD5 ;ISS/RAM - MD5 Handler ;06/28/00
- +1 ;;8.0;KERNEL;**407**;Jul 10, 1995;Build 8
- +2 ;
- +3 ;
- +4 QUIT
- +5 ;
- MAIN ; -- main
- +1 ;
- +2 NEW ERROR,CNT,HLFS,HLCS,MFI,QRD
- +3 ;
- +4 ;
- +5 DO INIT
- DO PROCESS
- DO MFR
- DO SEND
- DO EXIT
- +6 ;
- +7 QUIT
- +8 ;
- INIT ; -- initialize
- +1 ;
- +2 KILL ^TMP("HLA",$JOB)
- +3 ;
- +4 SET ERROR=0
- SET CNT=1
- +5 ;
- +6 SET HLFS=HL("FS")
- SET HLCS=$EXTRACT(HL("ECH"))
- SET HLSCS=$EXTRACT(HL("ECH"),4)
- +7 ;
- +8 QUIT
- +9 ;
- PROCESS ; -- pull message text
- +1 ;
- +2 FOR
- XECUTE HLNEXT
- if HLQUIT'>0
- QUIT
- Begin DoDot:1
- +3 if $PIECE(HLNODE,HLFS)=""
- QUIT
- +4 if "^MSH^MSA^QRD^"'[(U_$PIECE(HLNODE,HLFS)_U)
- QUIT
- +5 DO @($PIECE(HLNODE,HLFS))
- End DoDot:1
- +6 ;
- +7 QUIT
- +8 ;
- MSH ; -- MSH segment
- +1 ;
- +2 QUIT
- +3 ;
- QRD ; -- QRD segment
- +1 ;
- +2 SET MFI=$PIECE(HLNODE,HLFS,10)
- +3 IF MFI=""
- SET ERROR="1^MFI not resolved HLNODE: "_$TRANSLATE(HLNODE,HLFS,"#")
- QUIT
- +4 ;
- +5 DO EN^XUMF5I(MFI)
- +6 ;
- +7 SET QRD=HLNODE
- +8 ;
- +9 QUIT
- +10 ;
- MFR ; -- response
- +1 ;
- +2 DO MSA
- DO QRD1
- +3 ;
- +4 QUIT
- +5 ;
- MSA ; -- Acknowledgement
- +1 ;
- +2 NEW X
- +3 SET X="MSA"_HLFS_$SELECT(ERROR:"AE",1:"AA")_HLFS_HL("MID")_HLFS_$PIECE(ERROR,U,2)
- +4 SET ^TMP("HLA",$JOB,CNT)=X
- +5 SET CNT=CNT+1
- +6 ;
- +7 QUIT
- +8 ;
- QRD1 ; -- query definition segment
- +1 ;
- +2 SET ^TMP("HLA",$JOB,CNT)=QRD
- +3 SET CNT=CNT+1
- +4 ;
- +5 QUIT
- +6 ;
- SEND ; -- send HL7 message
- +1 ;
- +2 SET HLP("PRIORITY")="I"
- +3 DO GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"GM",1,.HLRESLT)
- +4 ;
- +5 ; check for error
- +6 IF ($PIECE($GET(HLRESLT),U,3)'="")
- Begin DoDot:1
- +7 SET ERROR=1_U_$PIECE(HLRESLT,HLFS,3)_U_$PIECE(HLRESLT,HLFS,2)_U_$PIECE(HLRESLT,U)
- End DoDot:1
- QUIT
- +8 ;
- +9 ; successful call, message ID returned
- +10 SET ERROR="0^"_$PIECE($GET(HLRESLT),U,1)
- +11 ;
- +12 QUIT
- +13 ;
- EXIT ; -- exit
- +1 ;
- +2 DO CLEAN^DILF
- +3 ;
- +4 KILL ^TMP("HLA",$JOB)
- +5 ;
- +6 QUIT
- +7 ;