- 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 Jan 18, 2025@03:40:51 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