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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRHLQRY 2274 printed Apr 09, 2024@21:46:05 Page 2
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
