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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRHLVQRY 2111 printed Dec 13, 2024@02:39:32 Page 2
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
