HLSERV.m

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

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