SRHLVZQR ;B'HAM ISC/PTD,DLR - Surgery Interface Sender of SQR Message ; [ 06/09/98 6:17 AM ]
;;3.0; Surgery ;**41**;24 Jun 93
; Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
;VISTA Surgery system responds to SQM message with SQR message.
;SQR can contain surgical data for a specified patient/date,
;or all surgical cases (scheduled, requested,...) for a
;specified date.
;Variables defined when this module is called:
;DFN - IEN in file #2 for a request of patient data.
; - "" for a request of all cases
;SRDT - Requested date in FileMan form
;
ZQR(DFN,SRDT) ;query response message for patient or all cases on a given date
N BDT,CASE,EDT,FIND,HLCOMP,HLREP,HLSUB,SRI
S SRI=1,HLCOMP=$E(HL("ECH"),1),HLREP=$E(HL("ECH"),2),HLSUB=$E(HL("ECH"),4),(HLMTN,HLSDT)="ZQR"
;Determine if data is available for requested date. If not, set HLERR and SRERR build error message and quit."
;specified patient cases ONLY
S FIND=0 I $G(DFN)'="" D I FIND=0 S HLERR="No cases for the requested patient.",SRERR="QRD"_HLCOMP_"8"_HLCOMP_HLCOMP_HLERR,SRAC="AE" D ERR(SRAC,SRERR) Q
.S CASE=0 F S CASE=$O(^SRF("B",DFN,CASE)) Q:'CASE I $P($P(^SRF(CASE,0),"^",9),".")=SRDT S FIND=1 Q
;all cases
I $G(DFN)="" D I FIND=0 S HLERR="No cases scheduled for date requested.",SRERR="QRF"_HLCOMP_"2"_HLCOMP_HLCOMP_HLERR,SRAC="AE" D ERR(SRAC,SRERR) Q
.S BDT=SRDT-.0001,EDT=SRDT+.9999 F S BDT=$O(^SRF("AC",BDT)) Q:'BDT!(BDT>EDT)!($G(FIND)=1) S CASE=0 F S CASE=$O(^SRF("AC",BDT,CASE)) Q:'CASE!($G(FIND)=1) S:$P($G(^SRF(CASE,31)),U,4) FIND=1
PROCESS ;Data exists for the requested date.
S SRAC="AA" D MSA^SRHLVUO(.SRI,SRAC)
S BDT=SRDT-.0001,EDT=SRDT+.9999 F S BDT=$O(^SRF("AC",BDT)) Q:'BDT!(BDT>EDT) S CASE=0 F S CASE=$O(^SRF("AC",BDT,CASE)) Q:'CASE D
.;all patient cases for a requested date
.I $G(DFN)'="" Q:DFN'=+$P(^SRF("AC",BDT,CASE),"^") D MSG
.;all cases for a requested date
.I $G(DFN)="" S DFN=$P(^SRF(CASE,0),"^") D MSG S DFN=""
Q
;
MSG ;Send ZQR message.
N SREVENT,SRSTATUS,SROERR
S (SREVENT,SRSTATUS)=""
S SROERR=CASE D STATUS^SROERR0
D ZCH^SRHLVUO1(.SRI,.SREVENT,.SRSTATUS,"HLA")
D PID^SRHLVUO(.SRI,"HLA")
D DG1^SRHLVUO(.SRI,"HLA")
D AL1^SRHLVUO(.SRI,"HLA")
D OBX^SRHLVUO(.SRI,"HLA")
D ZIS^SRHLVUO2(.SRI,"HLA")
D ZIG^SRHLVUO1(.SRI,"HLA")
D ZIP^SRHLVUO1(.SRI,"HLA")
D ZIL^SRHLVUO1(.SRI,"HLA")
Q
;
ERR(SRAC,SRERR) ;Error found, transmit error message.
N SRI
K ^TMP("HLA",$J)
S SRI=1
D MSA^SRHLVUO(.SRI,SRAC)
D ERR^SRHLVUO(.SRI,SRERR)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRHLVZQR 2549 printed Apr 09, 2024@21:51:30 Page 2
SRHLVZQR ;B'HAM ISC/PTD,DLR - Surgery Interface Sender of SQR Message ; [ 06/09/98 6:17 AM ]
+1 ;;3.0; Surgery ;**41**;24 Jun 93
+2 ; Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
+3 ;VISTA Surgery system responds to SQM message with SQR message.
+4 ;SQR can contain surgical data for a specified patient/date,
+5 ;or all surgical cases (scheduled, requested,...) for a
+6 ;specified date.
+7 ;Variables defined when this module is called:
+8 ;DFN - IEN in file #2 for a request of patient data.
+9 ; - "" for a request of all cases
+10 ;SRDT - Requested date in FileMan form
+11 ;
ZQR(DFN,SRDT) ;query response message for patient or all cases on a given date
+1 NEW BDT,CASE,EDT,FIND,HLCOMP,HLREP,HLSUB,SRI
+2 SET SRI=1
SET HLCOMP=$EXTRACT(HL("ECH"),1)
SET HLREP=$EXTRACT(HL("ECH"),2)
SET HLSUB=$EXTRACT(HL("ECH"),4)
SET (HLMTN,HLSDT)="ZQR"
+3 ;Determine if data is available for requested date. If not, set HLERR and SRERR build error message and quit."
+4 ;specified patient cases ONLY
+5 SET FIND=0
IF $GET(DFN)'=""
Begin DoDot:1
+6 SET CASE=0
FOR
SET CASE=$ORDER(^SRF("B",DFN,CASE))
if 'CASE
QUIT
IF $PIECE($PIECE(^SRF(CASE,0),"^",9),".")=SRDT
SET FIND=1
QUIT
End DoDot:1
IF FIND=0
SET HLERR="No cases for the requested patient."
SET SRERR="QRD"_HLCOMP_"8"_HLCOMP_HLCOMP_HLERR
SET SRAC="AE"
DO ERR(SRAC,SRERR)
QUIT
+7 ;all cases
+8 IF $GET(DFN)=""
Begin DoDot:1
+9 SET BDT=SRDT-.0001
SET EDT=SRDT+.9999
FOR
SET BDT=$ORDER(^SRF("AC",BDT))
if 'BDT!(BDT>EDT)!($GET(FIND)=1)
QUIT
SET CASE=0
FOR
SET CASE=$ORDER(^SRF("AC",BDT,CASE))
if 'CASE!($GET(FIND)=1)
QUIT
if $PIECE($GET(^SRF(CASE,31)),U,4)
SET FIND=1
End DoDot:1
IF FIND=0
SET HLERR="No cases scheduled for date requested."
SET SRERR="QRF"_HLCOMP_"2"_HLCOMP_HLCOMP_HLERR
SET SRAC="AE"
DO ERR(SRAC,SRERR)
QUIT
PROCESS ;Data exists for the requested date.
+1 SET SRAC="AA"
DO MSA^SRHLVUO(.SRI,SRAC)
+2 SET BDT=SRDT-.0001
SET EDT=SRDT+.9999
FOR
SET BDT=$ORDER(^SRF("AC",BDT))
if 'BDT!(BDT>EDT)
QUIT
SET CASE=0
FOR
SET CASE=$ORDER(^SRF("AC",BDT,CASE))
if 'CASE
QUIT
Begin DoDot:1
+3 ;all patient cases for a requested date
+4 IF $GET(DFN)'=""
if DFN'=+$PIECE(^SRF("AC",BDT,CASE),"^")
QUIT
DO MSG
+5 ;all cases for a requested date
+6 IF $GET(DFN)=""
SET DFN=$PIECE(^SRF(CASE,0),"^")
DO MSG
SET DFN=""
End DoDot:1
+7 QUIT
+8 ;
MSG ;Send ZQR message.
+1 NEW SREVENT,SRSTATUS,SROERR
+2 SET (SREVENT,SRSTATUS)=""
+3 SET SROERR=CASE
DO STATUS^SROERR0
+4 DO ZCH^SRHLVUO1(.SRI,.SREVENT,.SRSTATUS,"HLA")
+5 DO PID^SRHLVUO(.SRI,"HLA")
+6 DO DG1^SRHLVUO(.SRI,"HLA")
+7 DO AL1^SRHLVUO(.SRI,"HLA")
+8 DO OBX^SRHLVUO(.SRI,"HLA")
+9 DO ZIS^SRHLVUO2(.SRI,"HLA")
+10 DO ZIG^SRHLVUO1(.SRI,"HLA")
+11 DO ZIP^SRHLVUO1(.SRI,"HLA")
+12 DO ZIL^SRHLVUO1(.SRI,"HLA")
+13 QUIT
+14 ;
ERR(SRAC,SRERR) ;Error found, transmit error message.
+1 NEW SRI
+2 KILL ^TMP("HLA",$JOB)
+3 SET SRI=1
+4 DO MSA^SRHLVUO(.SRI,SRAC)
+5 DO ERR^SRHLVUO(.SRI,SRERR)
+6 QUIT
