- 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
