- HLSERV ;AISC/SAW-Server Routine for HL7 Messages Received Through MailMan ;5/27/93 15:08
- ;;1.6;HEALTH LEVEL SEVEN;;Oct 13, 1995
- ;This routine is used for the Version 1.5 Interface Only
- X XMREC G EXIT:XMER<0 G EXIT:"BHS,MSH"'[$E(XMRG,1,3) S HLL(1)=XMRG X XMREC G EXIT:XMER<0 S HLL(2)=XMRG D CHK^HLCHK
- N %,%H,%I D NOW^%DTC S HLDT=%,$P(HLL(1),HLFS,8)="" S ^TMP("HLR",$J,HLDT,1)=HLL(1),^(2)=HLL(2),HLXMZ=XMZ I '$D(HLNDAP0) S $P(HLNDAP0,"^",2)=$P(HLL(1),HLFS,6)
- F HLI=3:1 X XMREC Q:XMER<0 S ^TMP("HLR",$J,HLDT,HLI)=XMRG
- K HLL D IN^HLTF(HLMTN,HLMID,HLDT) I HLMTN="ACK"!(HLMTN="MCF") G EXIT:'$D(HLROU) D:HLROU'="^NONE"&(HLROU'="^")&('$D(HLERR)) @HLROU G EXIT
- S HLMT=$S(HLMTN="QRY":"ORF",HLMTN="ORM":"ORR",1:"ACK") S:$D(HLERR) HLMT="ACK" D MSH^HLCHK
- S HLTRANS=XMZ I $D(HLERR) D CREATE^HLTF(.HLX,.HLDA,.HLDT,.HLDT1) S HLSDATA(2)="MSA"_HLFS_"AR"_HLFS_HLMID_HLFS_HLERR D EN1^HLTRANS S XMZ=HLTRANS G EXIT
- D @HLROU S XMZ=HLTRANS
- EXIT D KILL^HLTRANS,KILL^HLCHK S XMSER="S.HL SERVER" D REMSBMSG^XMA1C
- K HLX,HLTIME,HLTRANS,XMSER,XMZ,^TMP("HLR",$J) Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLSERV 1058 printed Feb 18, 2025@23:26:13 Page 2
- HLSERV ;AISC/SAW-Server Routine for HL7 Messages Received Through MailMan ;5/27/93 15:08
- +1 ;;1.6;HEALTH LEVEL SEVEN;;Oct 13, 1995
- +2 ;This routine is used for the Version 1.5 Interface Only
- +3 XECUTE XMREC
- if XMER<0
- GOTO EXIT
- if "BHS,MSH"'[$EXTRACT(XMRG,1,3)
- GOTO EXIT
- SET HLL(1)=XMRG
- XECUTE XMREC
- if XMER<0
- GOTO EXIT
- SET HLL(2)=XMRG
- DO CHK^HLCHK
- +4 NEW %,%H,%I
- DO NOW^%DTC
- SET HLDT=%
- SET $PIECE(HLL(1),HLFS,8)=""
- SET ^TMP("HLR",$JOB,HLDT,1)=HLL(1)
- SET ^(2)=HLL(2)
- SET HLXMZ=XMZ
- IF '$DATA(HLNDAP0)
- SET $PIECE(HLNDAP0,"^",2)=$PIECE(HLL(1),HLFS,6)
- +5 FOR HLI=3:1
- XECUTE XMREC
- if XMER<0
- QUIT
- SET ^TMP("HLR",$JOB,HLDT,HLI)=XMRG
- +6 KILL HLL
- DO IN^HLTF(HLMTN,HLMID,HLDT)
- IF HLMTN="ACK"!(HLMTN="MCF")
- if '$DATA(HLROU)
- GOTO EXIT
- if HLROU'="^NONE"&(HLROU'="^")&('$DATA(HLERR))
- DO @HLROU
- GOTO EXIT
- +7 SET HLMT=$SELECT(HLMTN="QRY":"ORF",HLMTN="ORM":"ORR",1:"ACK")
- if $DATA(HLERR)
- SET HLMT="ACK"
- DO MSH^HLCHK
- +8 SET HLTRANS=XMZ
- IF $DATA(HLERR)
- DO CREATE^HLTF(.HLX,.HLDA,.HLDT,.HLDT1)
- SET HLSDATA(2)="MSA"_HLFS_"AR"_HLFS_HLMID_HLFS_HLERR
- DO EN1^HLTRANS
- SET XMZ=HLTRANS
- GOTO EXIT
- +9 DO @HLROU
- SET XMZ=HLTRANS
- EXIT DO KILL^HLTRANS
- DO KILL^HLCHK
- SET XMSER="S.HL SERVER"
- DO REMSBMSG^XMA1C
- +1 KILL HLX,HLTIME,HLTRANS,XMSER,XMZ,^TMP("HLR",$JOB)
- QUIT
