SRHLVZSQ.m

SRHLVZSQ ;B'HAM ISC/PTD,DLR - Surgery Interface Sender of ZSQ 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 QRY message with ZSQ message.

 ;ZSQ 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

 ;

ZSQ(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(HLECH,1),HLREP=$E(HLECH,2),HLSUB=$E(HLECH,4),(HLMTN,HLSDT)="ZSQ"

 ;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." 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." 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 ZSQ message.

 N SREVENT,SRSTATUS,SROERR

 S (SREVENT,SRSTATUS)=""

 S SROERR=CASE D STATUS^SROERR0

 D ZCH^SRHLVUO1(.SRI,.SREVENT,.SRSTATUS)

 D PID^SRHLVUO(.SRI)

 D OBX^SRHLVUO(.SRI)

 D DG1^SRHLVUO(.SRI)

 D AL1^SRHLVUO(.SRI)

 D ZIS^SRHLVUO2(.SRI)

 D ZIG^SRHLVUO1(.SRI)

 D ZIP^SRHLVUO1(.SRI)

 D ZIL^SRHLVUO1(.SRI)

 Q

 ;

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

 N SRI

 K ^TMP("HLS",$J)

 S SRI=1

 D MSA^SRHLVUO(.SRI,SRAC)

 D ERR^SRHLVUO(.SRI,SRERR)

 Q

SRHLVZSQ  ;B'HAM ISC/PTD,DLR - Surgery Interface Sender of ZSQ 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 QRY message with ZSQ message.

 +4       ;ZSQ 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      ;

ZSQ(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(HLECH,1)

           SET HLREP=$EXTRACT(HLECH,2)

           SET HLSUB=$EXTRACT(HLECH,4)

           SET (HLMTN,HLSDT)="ZSQ"

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

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

                   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 ZSQ message.

 +1        NEW SREVENT,SRSTATUS,SROERR

 +2        SET (SREVENT,SRSTATUS)=""

 +3        SET SROERR=CASE

           DO STATUS^SROERR0

 +4        DO ZCH^SRHLVUO1(.SRI,.SREVENT,.SRSTATUS)

 +5        DO PID^SRHLVUO(.SRI)

 +6        DO OBX^SRHLVUO(.SRI)

 +7        DO DG1^SRHLVUO(.SRI)

 +8        DO AL1^SRHLVUO(.SRI)

 +9        DO ZIS^SRHLVUO2(.SRI)

 +10       DO ZIG^SRHLVUO1(.SRI)

 +11       DO ZIP^SRHLVUO1(.SRI)

 +12       DO ZIL^SRHLVUO1(.SRI)

 +13       QUIT 

 +14      ;

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

 +1        NEW SRI

 +2        KILL ^TMP("HLS",$JOB)

 +3        SET SRI=1

 +4        DO MSA^SRHLVUO(.SRI,SRAC)

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

 +6        QUIT