SRHLVQRY.m

SRHLVQRY ;B'HAM ISC/PTD,DLR - Surgery Interface Receive of QRY 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 query messages for surgery cases

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

 K ^TMP("HLS",$J)

QUERY F II=0:0 S II=$O(^HL(772,HLDA,"IN",II)) Q:'II!$D(HLERR)  S SG=$E(^HL(772,HLDA,"IN",II,0),1,3),MSG=^HL(772,HLDA,"IN",II,0) D PICK

 I $D(HLERR) S SRAC="AE",SRERR="" D ERR^SRHLVZSQ(SRAC,SRERR)

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

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

 D:'$D(HLERR) ZSQ^SRHLVZSQ(DFN,SRDT)

 ;if no cases are found send AA with "no cases" message

 I $D(SRERR) S SRI=1 D MSA^SRHLVUO(.SRI,"AA")

EXIT ;Kill variables and quit.

 ;set message type for the outbound query acknowledgment

 S $P(HLSDATA(1),HLFS,9)="ZSQ",^TMP("HLS",$J,HLSDT,0)=HLSDATA(1)

 D EN1^HLTRANS

 Q

 ;

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

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

 I $T(@SG)="" S HLERR="Invalid segment in message "_$G(TYPE) Q

 Q

MSH ;Process the MSH segment.

 S HLFS=$E(MSG,4),HLECH=$E(MSG,5,8)

 S TYPE=$P(MSG,HLFS,9)

 S HLCOMP=$E(HLECH,1),HLREP=$E(HLECH,2),HLSUB=$E(HLECH,4)

 S HLNDAP=$O(^HL(770,"B",$P(MSG,HLFS,3),0))

 S (HLMTN,HLSDT)="ZSQ"

 Q

DSC Q

QRD ;Process QRD segment.

 N I,WDDC,WSF

 S DFN=""

 S WSF=$E($P(MSG,HLFS,9),1,3) I WSF'="ALL" S WSF=$$FMNAME^HLFNC(WSF)

 S WDDC=$E($P(MSG,HLFS,11),1,3)

 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 HLERR="Invalid Patient Name or SSN"

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

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

 Q

QRF ;Process QRF segment.

 S SRDT=$$FMDATE^HLFNC($P(MSG,HLFS,3))

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

 Q

SRHLVQRY  ;B'HAM ISC/PTD,DLR - Surgery Interface Receive of QRY 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 query messages for surgery cases

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

 +5        KILL ^TMP("HLS",$JOB)

QUERY      FOR II=0:0

               SET II=$ORDER(^HL(772,HLDA,"IN",II))

               IF 'II!$DATA(HLERR)

                   QUIT 

               SET SG=$EXTRACT(^HL(772,HLDA,"IN",II,0),1,3)

               SET MSG=^HL(772,HLDA,"IN",II,0)

               DO PICK

 +1        IF $DATA(HLERR)

               SET SRAC="AE"

               SET SRERR=""

               DO ERR^SRHLVZSQ(SRAC,SRERR)

 +2        IF '$DATA(SRDT)

               SET SRAC="AR"

               SET HLERR="Invalid or Missing QRF segment"

               SET SRERR=""

               DO ERR^SRHLVZSQ(SRAC,SRERR)

 +3        IF '$DATA(DFN)

               SET SRAC="AR"

               SET HLERR="Invalid or Missing QRD segment"

               SET SRERR=""

               DO ERR^SRHLVZSQ(SRAC,SRERR)

 +4        IF '$DATA(HLERR)

               DO ZSQ^SRHLVZSQ(DFN,SRDT)

 +5       ;if no cases are found send AA with "no cases" message

 +6        IF $DATA(SRERR)

               SET SRI=1

               DO MSA^SRHLVUO(.SRI,"AA")

EXIT      ;Kill variables and quit.

 +1       ;set message type for the outbound query acknowledgment

 +2        SET $PIECE(HLSDATA(1),HLFS,9)="ZSQ"

           SET ^TMP("HLS",$JOB,HLSDT,0)=HLSDATA(1)

 +3        DO EN1^HLTRANS

 +4        QUIT 

 +5       ;

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

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

               DO @SG

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

               SET HLERR="Invalid segment in message "_$GET(TYPE)

               QUIT 

 +3        QUIT 

MSH       ;Process the MSH segment.

 +1        SET HLFS=$EXTRACT(MSG,4)

           SET HLECH=$EXTRACT(MSG,5,8)

 +2        SET TYPE=$PIECE(MSG,HLFS,9)

 +3        SET HLCOMP=$EXTRACT(HLECH,1)

           SET HLREP=$EXTRACT(HLECH,2)

           SET HLSUB=$EXTRACT(HLECH,4)

 +4        SET HLNDAP=$ORDER(^HL(770,"B",$PIECE(MSG,HLFS,3),0))

 +5        SET (HLMTN,HLSDT)="ZSQ"

 +6        QUIT 

DSC        QUIT 

QRD       ;Process QRD segment.

 +1        NEW I,WDDC,WSF

 +2        SET DFN=""

 +3        SET WSF=$EXTRACT($PIECE(MSG,HLFS,9),1,3)

           IF WSF'="ALL"

               SET WSF=$$FMNAME^HLFNC(WSF)

 +4        SET WDDC=$EXTRACT($PIECE(MSG,HLFS,11),1,3)

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

               Begin DoDot:1

 +6                IF $DATA(WDDC)

                       FOR I=0:0

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

                           IF 'I

                               QUIT 

                           SET DFN=I

 +7                IF $GET(DFN)=""

                       SET HLERR="Invalid Patient Name or SSN"

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

                       IF $DATA(WSF)

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

                               SET HLERR="Invalid Patient Name or SSN"

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

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

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

               End DoDot:1

 +10       QUIT 

QRF       ;Process QRF segment.

 +1        SET SRDT=$$FMDATE^HLFNC($PIECE(MSG,HLFS,3))

 +2        IF '$DATA(SRDT)

               SET HLERR="Missing request date for surgical cases"

 +3        QUIT