SRHLQRY.m

SRHLQRY ;B'HAM ISC/DLR - Surgery Interface Receiver of SQM Message ; [ 05/06/98   7:14 AM ]

 ;;3.0; Surgery ;**41**;24 Jun 93

 ; Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.

 ;This routine processes incoming Schedule Query messages for surgery cases

 N DFN,HLCOMP,HLREP,HLSUB,II,MSG,SG,SRAC,SRDT,SRERR,TYPE

 K ^TMP("HLA",$J),HLMID

QUERY N I,J,X F I=1:1 X HLNEXT Q:HLQUIT'>0  S X(I)=HLNODE,J=0,SG=$E(X(I),1,3) D  S MSG=X(I) D PICK

 .F  S J=$O(HLNODE(J)) Q:'J  S X(I,J)=HLNODE(J)

 S HLCOMP=$E(HL("ECH"),1),HLREP=$E(HL("ECH"),2),HLSUB=$E(HL("ECH"),4)

 I $D(SRERR) I $G(SRERR)'["No cases scheduled for date requested" S SRAC="AE",SRERR="" D ERR^SRHLZQR(SRAC,SRERR)

 I '$D(SRDT) S SRAC="AR",SRERR="Invalid or Missing QRF segment",SRERR="" D ERR^SRHLZQR(SRAC,SRERR)

 I '$D(DFN) S SRAC="AR",SRERR="Invalid or Missing QRD segment",SRERR="" D ERR^SRHLZQR(SRAC,SRERR)

 D ZQR^SRHLZQR(DFN,SRDT)

EXIT ;Kill variables and quit.

 I $D(SRERR) S HLP("ERRTEXT")=SRERR

 ;setup message for the outbound query acknowledgment

 ;S HLEID=HL("EID"),HLEIDS=HL("EIDS"),HLARYTYP="GM",HLFORMAT=1,HLRESLTA="",HLMTIENA="",HLP=""

 ;D GENACK^HLMA1(HL("EID"),HLMID,HL("EIDS"),"GM",1,.HLRESLTA,.MTIEN)

 D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"GM",1,.HLRESLTA)

 Q

 ;

PICK ;For each segment found in the message, process the segment module.

 I $T(@SG)]"" D @SG

 I $T(@SG)="" Q

 Q

MSH ;;MSH

 ;Process the MSH segment.

 S (HLFS,HL("FS"))=$E(MSG,4),(HLECH,HL("ECH"))=$E(MSG,5,8)

 S TYPE=$P(MSG,HL("FS"),9)

 S HLCOMP=$E(HL("ECH"),1),HLREP=$E(HL("ECH"),2),HLSUB=$E(HL("ECH"),4)

 S HLQ=HL("Q")

 Q

QRD ;;QRD

 ;Process QRD segment.

 N I,WDDC,WSF

 S DFN=""

 S WSF=$P(MSG,HL("FS"),9) I WSF'="ALL" S WSF=$$FMNAME^HLFNC(WSF)

 S WDDC=$P(MSG,HL("FS"),11)

 I (WSF'="ALL")!(WDDC'="ALL") D

 .I $D(WDDC) F I=0:0 S I=$O(^DPT("SSN",+WDDC,I)) Q:'I  S DFN=I

 .I $G(DFN)="" S SRERR="Invalid Patient Name or SSN"

 .I $G(DFN)'="",$D(WSF) I WSF'=$E($P(^DPT(DFN,0),"^"),1,20) S SRERR="Invalid Patient Name or SSN"

 .I $G(DFN)'="" S:'$O(^SRF("B",DFN,0)) SRERR="Invalid Patient Name - not found in Surgery application"

 Q

QRF ;;QRF

 ;Process QRF segment.

 S SRDT=$$FMDATE^HLFNC($P(MSG,HL("FS"),3))

 I '$D(SRDT) S SRERR="Missing request date for surgical cases"

 Q

SRHLQRY   ;B'HAM ISC/DLR - Surgery Interface Receiver of SQM Message ; [ 05/06/98   7:14 AM ]

 +1       ;;3.0; Surgery ;**41**;24 Jun 93

 +2       ; Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.

 +3       ;This routine processes incoming Schedule Query messages for surgery cases

 +4        NEW DFN,HLCOMP,HLREP,HLSUB,II,MSG,SG,SRAC,SRDT,SRERR,TYPE

 +5        KILL ^TMP("HLA",$JOB),HLMID

QUERY      NEW I,J,X

           FOR I=1:1

               XECUTE HLNEXT

               IF HLQUIT'>0

                   QUIT 

               SET X(I)=HLNODE

               SET J=0

               SET SG=$EXTRACT(X(I),1,3)

               Begin DoDot:1

 +1                FOR 

                       SET J=$ORDER(HLNODE(J))

                       IF 'J

                           QUIT 

                       SET X(I,J)=HLNODE(J)

               End DoDot:1

               SET MSG=X(I)

               DO PICK

 +2        SET HLCOMP=$EXTRACT(HL("ECH"),1)

           SET HLREP=$EXTRACT(HL("ECH"),2)

           SET HLSUB=$EXTRACT(HL("ECH"),4)

 +3        IF $DATA(SRERR)

               IF $GET(SRERR)'["No cases scheduled for date requested"

                   SET SRAC="AE"

                   SET SRERR=""

                   DO ERR^SRHLZQR(SRAC,SRERR)

 +4        IF '$DATA(SRDT)

               SET SRAC="AR"

               SET SRERR="Invalid or Missing QRF segment"

               SET SRERR=""

               DO ERR^SRHLZQR(SRAC,SRERR)

 +5        IF '$DATA(DFN)

               SET SRAC="AR"

               SET SRERR="Invalid or Missing QRD segment"

               SET SRERR=""

               DO ERR^SRHLZQR(SRAC,SRERR)

 +6        DO ZQR^SRHLZQR(DFN,SRDT)

EXIT      ;Kill variables and quit.

 +1        IF $DATA(SRERR)

               SET HLP("ERRTEXT")=SRERR

 +2       ;setup message for the outbound query acknowledgment

 +3       ;S HLEID=HL("EID"),HLEIDS=HL("EIDS"),HLARYTYP="GM",HLFORMAT=1,HLRESLTA="",HLMTIENA="",HLP=""

 +4       ;D GENACK^HLMA1(HL("EID"),HLMID,HL("EIDS"),"GM",1,.HLRESLTA,.MTIEN)

 +5        DO GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"GM",1,.HLRESLTA)

 +6        QUIT 

 +7       ;

PICK      ;For each segment found in the message, process the segment module.

 +1        IF $TEXT(@SG)]""

               DO @SG

 +2        IF $TEXT(@SG)=""

               QUIT 

 +3        QUIT 

MSH       ;;MSH

 +1       ;Process the MSH segment.

 +2        SET (HLFS,HL("FS"))=$EXTRACT(MSG,4)

           SET (HLECH,HL("ECH"))=$EXTRACT(MSG,5,8)

 +3        SET TYPE=$PIECE(MSG,HL("FS"),9)

 +4        SET HLCOMP=$EXTRACT(HL("ECH"),1)

           SET HLREP=$EXTRACT(HL("ECH"),2)

           SET HLSUB=$EXTRACT(HL("ECH"),4)

 +5        SET HLQ=HL("Q")

 +6        QUIT 

QRD       ;;QRD

 +1       ;Process QRD segment.

 +2        NEW I,WDDC,WSF

 +3        SET DFN=""

 +4        SET WSF=$PIECE(MSG,HL("FS"),9)

           IF WSF'="ALL"

               SET WSF=$$FMNAME^HLFNC(WSF)

 +5        SET WDDC=$PIECE(MSG,HL("FS"),11)

 +6        IF (WSF'="ALL")!(WDDC'="ALL")

               Begin DoDot:1

 +7                IF $DATA(WDDC)

                       FOR I=0:0

                           SET I=$ORDER(^DPT("SSN",+WDDC,I))

                           IF 'I

                               QUIT 

                           SET DFN=I

 +8                IF $GET(DFN)=""

                       SET SRERR="Invalid Patient Name or SSN"

 +9                IF $GET(DFN)'=""

                       IF $DATA(WSF)

                           IF WSF'=$EXTRACT($PIECE(^DPT(DFN,0),"^"),1,20)

                               SET SRERR="Invalid Patient Name or SSN"

 +10               IF $GET(DFN)'=""

                       IF '$ORDER(^SRF("B",DFN,0))

                           SET SRERR="Invalid Patient Name - not found in Surgery application"

               End DoDot:1

 +11       QUIT 

QRF       ;;QRF

 +1       ;Process QRF segment.

 +2        SET SRDT=$$FMDATE^HLFNC($PIECE(MSG,HL("FS"),3))

 +3        IF '$DATA(SRDT)

               SET SRERR="Missing request date for surgical cases"

 +4        QUIT