| 1 | SRHLQRY ;B'HAM ISC/DLR - Surgery Interface Receiver of SQM 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 Schedule Query messages for surgery cases
|
|---|
| 5 | N DFN,HLCOMP,HLREP,HLSUB,II,MSG,SG,SRAC,SRDT,SRERR,TYPE
|
|---|
| 6 | K ^TMP("HLA",$J),HLMID
|
|---|
| 7 | 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
|
|---|
| 8 | .F S J=$O(HLNODE(J)) Q:'J S X(I,J)=HLNODE(J)
|
|---|
| 9 | S HLCOMP=$E(HL("ECH"),1),HLREP=$E(HL("ECH"),2),HLSUB=$E(HL("ECH"),4)
|
|---|
| 10 | I $D(SRERR) I $G(SRERR)'["No cases scheduled for date requested" S SRAC="AE",SRERR="" D ERR^SRHLZQR(SRAC,SRERR)
|
|---|
| 11 | I '$D(SRDT) S SRAC="AR",SRERR="Invalid or Missing QRF segment",SRERR="" D ERR^SRHLZQR(SRAC,SRERR)
|
|---|
| 12 | I '$D(DFN) S SRAC="AR",SRERR="Invalid or Missing QRD segment",SRERR="" D ERR^SRHLZQR(SRAC,SRERR)
|
|---|
| 13 | D ZQR^SRHLZQR(DFN,SRDT)
|
|---|
| 14 | EXIT ;Kill variables and quit.
|
|---|
| 15 | I $D(SRERR) S HLP("ERRTEXT")=SRERR
|
|---|
| 16 | ;setup message for the outbound query acknowledgment
|
|---|
| 17 | ;S HLEID=HL("EID"),HLEIDS=HL("EIDS"),HLARYTYP="GM",HLFORMAT=1,HLRESLTA="",HLMTIENA="",HLP=""
|
|---|
| 18 | ;D GENACK^HLMA1(HL("EID"),HLMID,HL("EIDS"),"GM",1,.HLRESLTA,.MTIEN)
|
|---|
| 19 | D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"GM",1,.HLRESLTA)
|
|---|
| 20 | Q
|
|---|
| 21 | ;
|
|---|
| 22 | PICK ;For each segment found in the message, process the segment module.
|
|---|
| 23 | I $T(@SG)]"" D @SG
|
|---|
| 24 | I $T(@SG)="" Q
|
|---|
| 25 | Q
|
|---|
| 26 | MSH ;;MSH
|
|---|
| 27 | ;Process the MSH segment.
|
|---|
| 28 | S (HLFS,HL("FS"))=$E(MSG,4),(HLECH,HL("ECH"))=$E(MSG,5,8)
|
|---|
| 29 | S TYPE=$P(MSG,HL("FS"),9)
|
|---|
| 30 | S HLCOMP=$E(HL("ECH"),1),HLREP=$E(HL("ECH"),2),HLSUB=$E(HL("ECH"),4)
|
|---|
| 31 | S HLQ=HL("Q")
|
|---|
| 32 | Q
|
|---|
| 33 | QRD ;;QRD
|
|---|
| 34 | ;Process QRD segment.
|
|---|
| 35 | N I,WDDC,WSF
|
|---|
| 36 | S DFN=""
|
|---|
| 37 | S WSF=$P(MSG,HL("FS"),9) I WSF'="ALL" S WSF=$$FMNAME^HLFNC(WSF)
|
|---|
| 38 | S WDDC=$P(MSG,HL("FS"),11)
|
|---|
| 39 | I (WSF'="ALL")!(WDDC'="ALL") D
|
|---|
| 40 | .I $D(WDDC) F I=0:0 S I=$O(^DPT("SSN",+WDDC,I)) Q:'I S DFN=I
|
|---|
| 41 | .I $G(DFN)="" S SRERR="Invalid Patient Name or SSN"
|
|---|
| 42 | .I $G(DFN)'="",$D(WSF) I WSF'=$E($P(^DPT(DFN,0),"^"),1,20) S SRERR="Invalid Patient Name or SSN"
|
|---|
| 43 | .I $G(DFN)'="" S:'$O(^SRF("B",DFN,0)) SRERR="Invalid Patient Name - not found in Surgery application"
|
|---|
| 44 | Q
|
|---|
| 45 | QRF ;;QRF
|
|---|
| 46 | ;Process QRF segment.
|
|---|
| 47 | S SRDT=$$FMDATE^HLFNC($P(MSG,HL("FS"),3))
|
|---|
| 48 | I '$D(SRDT) S SRERR="Missing request date for surgical cases"
|
|---|
| 49 | Q
|
|---|
