SCAPMC29.m

SCAPMC29 ;ALB/REW - TEAM APIs:CLPT  ; 2/17/00 1:33pm

 ;;5.3;Scheduling;**41,210,520,1015**;AUG 13, 1993;Build 21

 ;;1.0

CLPT(DFN,SCDATES,SCTEAMA,SCLIST,SCERR) ;clinics for patient

 ; input:

 ;  DFN = ien of PATIENT <FILE#2> [required]

 ;  SCDATES("BEGIN") = begin date to search (inclusive)

 ;                       [default: TODAY]

 ;         ("END")   = end date to search (inclusive)

 ;                       [default: TODAY]

 ;         ("INCL")  = 1: only use pracitioners who were on

 ;                       team for entire date range

 ;                     0: anytime in date range

 ;                      [default: 1] 

 ;  SCTEAMA= array of teams to include reverse with scposa('exclude')

 ;  SCERR = array NAME to store error messages.

 ;          [ex. ^TMP("ORXX",$J)]

 ;

 ; Output:

 ;  SCLIST() = array of clinics

 ;             Format:

 ;               Subscript: Sequential # from 1 to n

 ;               Piece     Description

 ;                 1       IEN of HOSPITAL LOCATION file entry (#44)

 ;                 2       Name of CLINIC

 ;                 3       ENROLLMENT DATE

 ;                 4       DISCHARGE DATE

 ;                 5       OPT OR AC

 ;                 6       REVIEW DATE

 ;

 ;  SCERR()  = Array of DIALOG file messages(errors) .

 ;  @SCERR(0)= Number of error(s), UNDEFINED if no errors

 ;             Foramt:

 ;               Subscript: Sequential # from 1 to n

 ;               Piece     Description

 ;                 1       IEN of DIALOG file

 ;   Returned: 1 if ok, 0 if error

 ;

 ; -- initialize control variables

 ;

ST N SCX,SCS,SC44,SCACOPT,SCTM,SCPOSA,SCTP

 N SCLSEQ,SCN,SCESEQ,SCPARM,SCP,SCBEGIN,SCEND,SCINCL,SCDTS,SCOK,SCS,SCND,SCACT,SCINACT,SCREVDT,SCCLNM

 G:'$$OKDATA PTCLQ ; check/setup variables

 IF $L($G(SCTEAMA)) D

 .S SCTM=0

 .F  S SCTM=$O(@SCTEAMA@(SCTM)) Q:'SCTM  D  Q:'SCX

 ..S SCX=$$TPTM^SCAPMC(SCTM,SCDATES,,,"SCPOSAX",.SCERR)

 .F SCX=1:1 S SCTP=+$G(SCPOSAX(SCX)) Q:'SCTP  S SCPOSA(SCTP)=""

 .S:$D(@SCTEAMA@("EXCLUDE")) SCPOSA("EXCLUDE")=""

 ;S SCX=0 F  S SCX=$O(^DPT(DFN,"DE",SCX)) Q:'SCX  D

 ;.S SC44=+$G(^DPT(DFN,"DE",SCX,0))

 ;.Q:'SC44

 ;.Q:'$$OKCLIN(SC44,.SCPOSA)

 ;.S SCCLNM=$P($G(^SC(SC44,0)),U,1)

 ;.S SCS=0 F  S SCS=$O(^DPT(DFN,"DE",SCX,1,SCS)) Q:'SCS  D

 ;..S SCND=$G(^DPT(DFN,"DE",SCX,1,SCS,0))

 ;..S SCACT=$P(SCND,U,1)

 ;..S SCINACT=$P(SCND,U,3)

 ;..Q:'$$DTCHK^SCAPU1(SCBEGIN,SCEND,SCINCL,SCACT,SCINACT)

 ;..S SCACOPT=$P(SCND,U,2)

 ;..S SCREVDT=$P(SCND,U,5)

 ;..S SCN=$G(@SCLIST@(0),0)+1

 ;..;bp/ar nois brx-1298-12323 prevent undefined variable error

 ;..;New code begins

 ;..Q:'SCACT

 ;..Q:'SCN

 ;.;End of brx-1298-12323

 ;..S @SCLIST@(0)=SCN

 ;..S @SCLIST@(SCN)=SC44_U_SCCLNM_U_SCACT_U_SCINACT_U_SCACOPT_U_SCREVDT

 ;..S @SCLIST@("SCCL",SC44,SCACT,SCN)=""

PTCLQ Q $G(@SCERR@(0))<1

 ;

OKCLIN(SC44,SCPOSA) ;is clinic ok, given position array

 N SCOK,SCTP

 IF '$D(SCPOSA) S SCOK=1 G QTOKC

 S (SCOK,SCTP)=0

 F  S SCTP=$O(^SCTM(404.57,"E",+SC44,SCTP)) Q:'SCTP  S:$$OKARRAY^SCAPU1(.SCPOSA,SCTP) SCOK=1

QTOKC Q SCOK

 ;

OKDATA() ;check/setup variables - return 1 if ok; 0 if error

 N SCOK

 S SCOK=1

 D INIT^SCAPMCU1(.SCOK) ; set default dates & error array (if undefined)

 IF '$D(^DPT(+$G(DFN),0)) D  S SCOK=0

 . S SCPARM("PATIENT")=$G(DFN,"Undefined")

 . D ERR^SCAPMCU1(.SCESEQ,4045101,.SCPARM,"",.SCERR)

 Q SCOK

SCAPMC29  ;ALB/REW - TEAM APIs:CLPT  ; 2/17/00 1:33pm

 +1       ;;5.3;Scheduling;**41,210,520,1015**;AUG 13, 1993;Build 21

 +2       ;;1.0

CLPT(DFN,SCDATES,SCTEAMA,SCLIST,SCERR) ;clinics for patient

 +1       ; input:

 +2       ;  DFN = ien of PATIENT <FILE#2> [required]

 +3       ;  SCDATES("BEGIN") = begin date to search (inclusive)

 +4       ;                       [default: TODAY]

 +5       ;         ("END")   = end date to search (inclusive)

 +6       ;                       [default: TODAY]

 +7       ;         ("INCL")  = 1: only use pracitioners who were on

 +8       ;                       team for entire date range

 +9       ;                     0: anytime in date range

 +10      ;                      [default: 1] 

 +11      ;  SCTEAMA= array of teams to include reverse with scposa('exclude')

 +12      ;  SCERR = array NAME to store error messages.

 +13      ;          [ex. ^TMP("ORXX",$J)]

 +14      ;

 +15      ; Output:

 +16      ;  SCLIST() = array of clinics

 +17      ;             Format:

 +18      ;               Subscript: Sequential # from 1 to n

 +19      ;               Piece     Description

 +20      ;                 1       IEN of HOSPITAL LOCATION file entry (#44)

 +21      ;                 2       Name of CLINIC

 +22      ;                 3       ENROLLMENT DATE

 +23      ;                 4       DISCHARGE DATE

 +24      ;                 5       OPT OR AC

 +25      ;                 6       REVIEW DATE

 +26      ;

 +27      ;  SCERR()  = Array of DIALOG file messages(errors) .

 +28      ;  @SCERR(0)= Number of error(s), UNDEFINED if no errors

 +29      ;             Foramt:

 +30      ;               Subscript: Sequential # from 1 to n

 +31      ;               Piece     Description

 +32      ;                 1       IEN of DIALOG file

 +33      ;   Returned: 1 if ok, 0 if error

 +34      ;

 +35      ; -- initialize control variables

 +36      ;

ST         NEW SCX,SCS,SC44,SCACOPT,SCTM,SCPOSA,SCTP

 +1        NEW SCLSEQ,SCN,SCESEQ,SCPARM,SCP,SCBEGIN,SCEND,SCINCL,SCDTS,SCOK,SCS,SCND,SCACT,SCINACT,SCREVDT,SCCLNM

 +2       ; check/setup variables

           IF '$$OKDATA

               GOTO PTCLQ

 +3        IF $LENGTH($GET(SCTEAMA))

               Begin DoDot:1

 +4                SET SCTM=0

 +5                FOR 

                       SET SCTM=$ORDER(@SCTEAMA@(SCTM))

                       IF 'SCTM

                           QUIT 

                       Begin DoDot:2

 +6                        SET SCX=$$TPTM^SCAPMC(SCTM,SCDATES,,,"SCPOSAX",.SCERR)

                       End DoDot:2

                       IF 'SCX

                           QUIT 

 +7                FOR SCX=1:1

                       SET SCTP=+$GET(SCPOSAX(SCX))

                       IF 'SCTP

                           QUIT 

                       SET SCPOSA(SCTP)=""

 +8                IF $DATA(@SCTEAMA@("EXCLUDE"))

                       SET SCPOSA("EXCLUDE")=""

               End DoDot:1

 +9       ;S SCX=0 F  S SCX=$O(^DPT(DFN,"DE",SCX)) Q:'SCX  D

 +10      ;.S SC44=+$G(^DPT(DFN,"DE",SCX,0))

 +11      ;.Q:'SC44

 +12      ;.Q:'$$OKCLIN(SC44,.SCPOSA)

 +13      ;.S SCCLNM=$P($G(^SC(SC44,0)),U,1)

 +14      ;.S SCS=0 F  S SCS=$O(^DPT(DFN,"DE",SCX,1,SCS)) Q:'SCS  D

 +15      ;..S SCND=$G(^DPT(DFN,"DE",SCX,1,SCS,0))

 +16      ;..S SCACT=$P(SCND,U,1)

 +17      ;..S SCINACT=$P(SCND,U,3)

 +18      ;..Q:'$$DTCHK^SCAPU1(SCBEGIN,SCEND,SCINCL,SCACT,SCINACT)

 +19      ;..S SCACOPT=$P(SCND,U,2)

 +20      ;..S SCREVDT=$P(SCND,U,5)

 +21      ;..S SCN=$G(@SCLIST@(0),0)+1

 +22      ;..;bp/ar nois brx-1298-12323 prevent undefined variable error

 +23      ;..;New code begins

 +24      ;..Q:'SCACT

 +25      ;..Q:'SCN

 +26      ;.;End of brx-1298-12323

 +27      ;..S @SCLIST@(0)=SCN

 +28      ;..S @SCLIST@(SCN)=SC44_U_SCCLNM_U_SCACT_U_SCINACT_U_SCACOPT_U_SCREVDT

 +29      ;..S @SCLIST@("SCCL",SC44,SCACT,SCN)=""

PTCLQ      QUIT $GET(@SCERR@(0))<1

 +1       ;

OKCLIN(SC44,SCPOSA) ;is clinic ok, given position array

 +1        NEW SCOK,SCTP

 +2        IF '$DATA(SCPOSA)

               SET SCOK=1

               GOTO QTOKC

 +3        SET (SCOK,SCTP)=0

 +4        FOR 

               SET SCTP=$ORDER(^SCTM(404.57,"E",+SC44,SCTP))

               IF 'SCTP

                   QUIT 

               IF $$OKARRAY^SCAPU1(.SCPOSA,SCTP)

                   SET SCOK=1

QTOKC      QUIT SCOK

 +1       ;

OKDATA()  ;check/setup variables - return 1 if ok; 0 if error

 +1        NEW SCOK

 +2        SET SCOK=1

 +3       ; set default dates & error array (if undefined)

           DO INIT^SCAPMCU1(.SCOK)

 +4        IF '$DATA(^DPT(+$GET(DFN),0))

               Begin DoDot:1

 +5                SET SCPARM("PATIENT")=$GET(DFN,"Undefined")

 +6                DO ERR^SCAPMCU1(.SCESEQ,4045101,.SCPARM,"",.SCERR)

               End DoDot:1

               SET SCOK=0

 +7        QUIT SCOK