source: WorldVistAEHR/trunk/r/SURGERY-SR/SRHLZQR.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.4 KB
RevLine 
[613]1SRHLZQR ;B'HAM ISC/PTD,DLR - Surgery Interface Sender of SQR Message ; [ 06/09/98 6:17 AM ]
2 ;;3.0; Surgery ;**41**;24 Jun 93
3 ; Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
4 ;VISTA Surgery system responds to SQM message with SQR message.
5 ;SQR can contain surgical data for a specified patient/date,
6 ;or all surgical cases (scheduled, requested,...) for a
7 ;specified date.
8 ;Variables defined when this module is called:
9 ;DFN - IEN in file #2 for a request of patient data.
10 ; - "" for a request of all cases
11 ;SRDT - Requested date in FileMan form
12 ;
13ZQR(DFN,SRDT) ;query response message for patient or all cases on a given date
14 N BDT,CASE,EDT,FIND,SRI
15 S SRI=1
16 ;,HLCOMP=$E(HL("ECH"),1),HLREP=$E(HL("ECH"),2),HLSUB=$E(HL("ECH"),4),(HLMTN,HLSDT)="ZQR"
17 ;Determine if data is available for requested date. If not, set HLERR and SRERR build error message and quit."
18 ;specified patient cases ONLY
19 S FIND=0 I $G(DFN)'="" D I FIND=0 S SRERR="No cases for the requested patient." ;,SRERR="QRD"_HLCOMP_"8"_HLCOMP_HLCOMP_SRERR,SRAC="AE" D ERR(SRAC,SRERR) Q
20 .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
21 ;all cases
22 I $G(DFN)="" D I FIND=0 S SRERR="No cases scheduled for date requested." ;,SRERR="QRF"_HLCOMP_"2"_HLCOMP_HLCOMP_$G(SRERR),SRAC="AE" D ERR(SRAC,SRERR) Q
23 .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
24PROCESS ;Data exists for the requested date.
25 S SRAC="AA" D MSA^SRHLUO(.SRI,SRAC)
26 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
27 .;all patient cases for a requested date
28 .I $G(DFN)'="" Q:DFN'=+$P(^SRF("AC",BDT,CASE),"^") D MSG
29 .;all cases for a requested date
30 .I $G(DFN)="" S DFN=$P(^SRF(CASE,0),"^") D MSG S DFN=""
31 Q
32 ;
33MSG ;Send ZQR message.
34 N SREVENT,SRSTATUS,SROERR
35 S (SREVENT,SRSTATUS)=""
36 S SROERR=CASE D STATUS^SROERR0
37 D ZCH^SRHLUO1(.SRI,.SREVENT,.SRSTATUS,"HLA")
38 D PID^SRHLUO(.SRI,"HLA")
39 D AL1^SRHLUO(.SRI,"HLA")
40 D OBX^SRHLUO(.SRI,"HLA")
41 D DG1^SRHLUO(.SRI,"HLA")
42 D ZIS^SRHLUO2(.SRI,"HLA")
43 D ZIG^SRHLUO1(.SRI,"HLA")
44 D ZIP^SRHLUO1(.SRI,"HLA")
45 D ZIL^SRHLUO1(.SRI,"HLA")
46 Q
47 ;
48ERR(SRAC,SRERR) ;Error found, transmit error message.
49 N SRI
50 K ^TMP("HLA",$J)
51 S SRI=1
52 D MSA^SRHLUO(.SRI,SRAC)
53 D ERR^SRHLUO(.SRI,SRERR)
54 Q
Note: See TracBrowser for help on using the repository browser.