| [613] | 1 | SRHLVQRY ;B'HAM ISC/PTD,DLR - Surgery Interface Receive of QRY Message ; [ 05/06/98 7:14 AM ]
|
|---|
| 2 | ;;3.0; Surgery ;**41**;24 Jun 93
|
|---|
| 3 | ; Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
|
|---|
| 4 | ;This routine processes incoming query messages for surgery cases
|
|---|
| 5 | N DFN,HLCOMP,HLREP,HLSUB,II,MSG,SG,SRAC,SRDT,SRERR,TYPE
|
|---|
| 6 | K ^TMP("HLS",$J)
|
|---|
| 7 | 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
|
|---|
| 8 | I $D(HLERR) S SRAC="AE",SRERR="" D ERR^SRHLVZSQ(SRAC,SRERR)
|
|---|
| 9 | I '$D(SRDT) S SRAC="AR",HLERR="Invalid or Missing QRF segment",SRERR="" D ERR^SRHLVZSQ(SRAC,SRERR)
|
|---|
| 10 | I '$D(DFN) S SRAC="AR",HLERR="Invalid or Missing QRD segment",SRERR="" D ERR^SRHLVZSQ(SRAC,SRERR)
|
|---|
| 11 | D:'$D(HLERR) ZSQ^SRHLVZSQ(DFN,SRDT)
|
|---|
| 12 | ;if no cases are found send AA with "no cases" message
|
|---|
| 13 | I $D(SRERR) S SRI=1 D MSA^SRHLVUO(.SRI,"AA")
|
|---|
| 14 | EXIT ;Kill variables and quit.
|
|---|
| 15 | ;set message type for the outbound query acknowledgment
|
|---|
| 16 | S $P(HLSDATA(1),HLFS,9)="ZSQ",^TMP("HLS",$J,HLSDT,0)=HLSDATA(1)
|
|---|
| 17 | D EN1^HLTRANS
|
|---|
| 18 | Q
|
|---|
| 19 | ;
|
|---|
| 20 | PICK ;For each segment found in the message, process the segment module.
|
|---|
| 21 | I $T(@SG)]"" D @SG
|
|---|
| 22 | I $T(@SG)="" S HLERR="Invalid segment in message "_$G(TYPE) Q
|
|---|
| 23 | Q
|
|---|
| 24 | MSH ;Process the MSH segment.
|
|---|
| 25 | S HLFS=$E(MSG,4),HLECH=$E(MSG,5,8)
|
|---|
| 26 | S TYPE=$P(MSG,HLFS,9)
|
|---|
| 27 | S HLCOMP=$E(HLECH,1),HLREP=$E(HLECH,2),HLSUB=$E(HLECH,4)
|
|---|
| 28 | S HLNDAP=$O(^HL(770,"B",$P(MSG,HLFS,3),0))
|
|---|
| 29 | S (HLMTN,HLSDT)="ZSQ"
|
|---|
| 30 | Q
|
|---|
| 31 | DSC Q
|
|---|
| 32 | QRD ;Process QRD segment.
|
|---|
| 33 | N I,WDDC,WSF
|
|---|
| 34 | S DFN=""
|
|---|
| 35 | S WSF=$E($P(MSG,HLFS,9),1,3) I WSF'="ALL" S WSF=$$FMNAME^HLFNC(WSF)
|
|---|
| 36 | S WDDC=$E($P(MSG,HLFS,11),1,3)
|
|---|
| 37 | I (WSF'="ALL")!(WDDC'="ALL") D
|
|---|
| 38 | .I $D(WDDC) F I=0:0 S I=$O(^DPT("SSN",+WDDC,I)) Q:'I S DFN=I
|
|---|
| 39 | .I $G(DFN)="" S HLERR="Invalid Patient Name or SSN"
|
|---|
| 40 | .I $G(DFN)'="",$D(WSF) I WSF'=$E($P(^DPT(DFN,0),"^"),1,20) S HLERR="Invalid Patient Name or SSN"
|
|---|
| 41 | .I $G(DFN)'="" S:'$O(^SRF("B",DFN,0)) HLERR="Invalid Patient Name - not found in Surgery application"
|
|---|
| 42 | Q
|
|---|
| 43 | QRF ;Process QRF segment.
|
|---|
| 44 | S SRDT=$$FMDATE^HLFNC($P(MSG,HLFS,3))
|
|---|
| 45 | I '$D(SRDT) S HLERR="Missing request date for surgical cases"
|
|---|
| 46 | Q
|
|---|
