SRHLZQR.m

SRHLZQR ;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,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 SRERR="No cases for the requested patient." ;,SRERR="QRD"_HLCOMP_"8"_HLCOMP_HLCOMP_SRERR,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 SRERR="No cases scheduled for date requested." ;,SRERR="QRF"_HLCOMP_"2"_HLCOMP_HLCOMP_$G(SRERR),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^SRHLUO(.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^SRHLUO1(.SRI,.SREVENT,.SRSTATUS,"HLA")

 D PID^SRHLUO(.SRI,"HLA")

 D AL1^SRHLUO(.SRI,"HLA")

 D OBX^SRHLUO(.SRI,"HLA")

 D DG1^SRHLUO(.SRI,"HLA")

 D ZIS^SRHLUO2(.SRI,"HLA")

 D ZIG^SRHLUO1(.SRI,"HLA")

 D ZIP^SRHLUO1(.SRI,"HLA")

 D ZIL^SRHLUO1(.SRI,"HLA")

 Q

 ;

ERR(SRAC,SRERR) ;Error found, transmit error message.

 N SRI

 K ^TMP("HLA",$J)

 S SRI=1

 D MSA^SRHLUO(.SRI,SRAC)

 D ERR^SRHLUO(.SRI,SRERR)

 Q

SRHLZQR   ;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,SRI

 +2        SET SRI=1

 +3       ;,HLCOMP=$E(HL("ECH"),1),HLREP=$E(HL("ECH"),2),HLSUB=$E(HL("ECH"),4),(HLMTN,HLSDT)="ZQR"

 +4       ;Determine if data is available for requested date.  If not, set HLERR and SRERR build error message and quit."

 +5       ;specified patient cases ONLY

 +6       ;,SRERR="QRD"_HLCOMP_"8"_HLCOMP_HLCOMP_SRERR,SRAC="AE" D ERR(SRAC,SRERR) Q

           SET FIND=0

           IF $GET(DFN)'=""

               Begin DoDot:1

 +7                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 SRERR="No cases for the requested patient."

 +8       ;all cases

 +9       ;,SRERR="QRF"_HLCOMP_"2"_HLCOMP_HLCOMP_$G(SRERR),SRAC="AE" D ERR(SRAC,SRERR) Q

           IF $GET(DFN)=""

               Begin DoDot:1

 +10               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 SRERR="No cases scheduled for date requested."

PROCESS   ;Data exists for the requested date.

 +1        SET SRAC="AA"

           DO MSA^SRHLUO(.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^SRHLUO1(.SRI,.SREVENT,.SRSTATUS,"HLA")

 +5        DO PID^SRHLUO(.SRI,"HLA")

 +6        DO AL1^SRHLUO(.SRI,"HLA")

 +7        DO OBX^SRHLUO(.SRI,"HLA")

 +8        DO DG1^SRHLUO(.SRI,"HLA")

 +9        DO ZIS^SRHLUO2(.SRI,"HLA")

 +10       DO ZIG^SRHLUO1(.SRI,"HLA")

 +11       DO ZIP^SRHLUO1(.SRI,"HLA")

 +12       DO ZIL^SRHLUO1(.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^SRHLUO(.SRI,SRAC)

 +5        DO ERR^SRHLUO(.SRI,SRERR)

 +6        QUIT