SCAPMC2.m

SCAPMC2 ;ALB/REW - Team API's: PTTM ; JUN 30, 1995

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

 ;IHS/ANMC/LJF 11/02/2000 replaced SSN as Long ID with HRCN

 ;

 ;;1.0

PTTM(SCTEAM,SCDATES,SCLIST,SCERR) ; -- list of patient team assignments

 ; input:

 ;  SCTEAM = ien of TEAM [required]

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

 ;                      [default: TODAY]

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

 ;                      [default: TODAY]

 ;        ("INCL")  = 1: only use patients who were assigned to

 ;                       team for entire date range

 ;                    0: anytime in date range

 ;                      [default: 1] 

 ;  SCLIST -array name to store list

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

 ;        

 ;  SCERR = array NAME to store error messages.

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

 ;

 ; Output:

 ;  SCLIST() = array of patients

 ;             Format:

 ;               Subscript: Sequential # from 1 to n

 ;               Piece     Description

 ;                 1       IEN of PATIENT file entry

 ;                 2       Name of patient

 ;                 3       IEN of Patient Team Assignment

 ;                 4       Activation Date

 ;                 5       Inactivation Date

 ;                 6       Patient Long ID (SSN)

 ;

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

 ;  @SCERR@(0)=number of errors, undefined if none

 ;             Foramt:

 ;               Subscript: Sequential # from 1 to n

 ;               Piece     Description

 ;                 1       IEN of DIALOG file

 ;

 ;   Returned: 1 if ok, 0 if error

 ;

 ;

ST N SCPT,SCPTA,SCPTA0

 N SCLSEQ,SCN,SCESEQ,SCPARM,SCP,SCBEGIN,SCEND,SCINCL,SCDTS

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

 ; -- loop through patient team assignments

LP S SCPT=0

 F  S SCPT=$O(^SCPT(404.42,"ATMPT",SCTEAM,SCPT)) Q:'SCPT  D

 .S SCPTA=0

 .F  S SCPTA=$O(^SCPT(404.42,"ATMPT",SCTEAM,SCPT,SCPTA)) Q:'SCPTA  D

 ..S SCPTA0=$G(^SCPT(404.42,SCPTA,0))

 ..Q:'SCPTA0

 ..Q:'$$DTCHK^SCAPU1(SCBEGIN,SCEND,SCINCL,$P(SCPTA0,U,2),$P(SCPTA0,U,9))

 ..D BLD(.SCLIST,SCPTA,SCPTA0,.SCN)

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

 ;

 ;

BLD(SCLIST,SCPTA,SCPTA0,SCN) ; build list

 ;

 ; SCPA    - ien of patient team assignment file #404.42

 ; SCEFFDT - negative of effective date

 ; SCN     - current subscript (counter) 1->n

 ; SCPTA0   is 0 node of Patient Team Assignment file 1st piece is DFN

 ; 

 ; this builds the array:

 ;   sclist(1->n)=sc2^ptname^effdt^inactdt

 ;    for each scpta zero node passed to it

 Q:'SCPTA!('SCPTA0)  ;add error trapping?

 Q:$D(@SCLIST@("SCPTA",+SCPTA0,SCPTA))

 Q:$D(^TMP("SCMC",$J,"EXCLUDE PT","SCPTA",+SCPTA0))

 N SCEFFDT,SCCNT

 S SCN=SCN+1

 ;S @SCLIST@(SCN)=+SCPTA0_U_$P($G(^DPT(+SCPTA0,0)),U,1)_U_SCPTA_U_$P(SCPTA0,U,2)_U_$P(SCPTA0,U,9)_U_$P($G(^DPT(+SCPTA0,.36)),U,3)

 S @SCLIST@(SCN)=+SCPTA0_U_$P($G(^DPT(+SCPTA0,0)),U,1)_U_SCPTA_U_$P(SCPTA0,U,2)_U_$P(SCPTA0,U,9)_U_$$HRCN^BDGF2(+SCPTA0,+$G(DUZ(2)))  ;IHS/ANMC/LJF 11/2/2000

 ;_U_$P(SCPTA0,U,3)_U_$P($G(^SCTM(404.51,+$P(SCPTA0,U,3),0)),U,1) - didn't include team data to make return array generic

 S @SCLIST@("SCPTA",+SCPTA0,SCPTA,SCN)=""

 Q

OKDATA() ;check/setup variables

 N SCOK

 S SCOK=1

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

 IF '$D(^SCTM(404.51,+$G(SCTEAM),0)) D  S SCOK=0

 . S SCPARM("TEAM")=$G(SCTEAM,"Undefined")

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

 ; -- is it a valid TEAM ien passed (Error # 4045101 in DIALOG file)

 IF '$D(^SCTM(404.51,+SCTEAM,0)) D  S SCOK=0

 . S SCPARM("TEAM")=SCTEAM

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

 Q SCOK

SCAPMC2   ;ALB/REW - Team API's: PTTM ; JUN 30, 1995

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

 +2       ;IHS/ANMC/LJF 11/02/2000 replaced SSN as Long ID with HRCN

 +3       ;

 +4       ;;1.0

PTTM(SCTEAM,SCDATES,SCLIST,SCERR) ; -- list of patient team assignments

 +1       ; input:

 +2       ;  SCTEAM = ien of TEAM [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 patients who were assigned to

 +8       ;                       team for entire date range

 +9       ;                    0: anytime in date range

 +10      ;                      [default: 1] 

 +11      ;  SCLIST -array name to store list

 +12      ;          [ex. ^TMP("SCPT",$J)]

 +13      ;        

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

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

 +16      ;

 +17      ; Output:

 +18      ;  SCLIST() = array of patients

 +19      ;             Format:

 +20      ;               Subscript: Sequential # from 1 to n

 +21      ;               Piece     Description

 +22      ;                 1       IEN of PATIENT file entry

 +23      ;                 2       Name of patient

 +24      ;                 3       IEN of Patient Team Assignment

 +25      ;                 4       Activation Date

 +26      ;                 5       Inactivation Date

 +27      ;                 6       Patient Long ID (SSN)

 +28      ;

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

 +30      ;  @SCERR@(0)=number of errors, undefined if none

 +31      ;             Foramt:

 +32      ;               Subscript: Sequential # from 1 to n

 +33      ;               Piece     Description

 +34      ;                 1       IEN of DIALOG file

 +35      ;

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

 +37      ;

 +38      ;

ST         NEW SCPT,SCPTA,SCPTA0

 +1        NEW SCLSEQ,SCN,SCESEQ,SCPARM,SCP,SCBEGIN,SCEND,SCINCL,SCDTS

 +2       ;check/setup variables

           IF '$$OKDATA

               GOTO PRACQ

 +3       ; -- loop through patient team assignments

LP         SET SCPT=0

 +1        FOR 

               SET SCPT=$ORDER(^SCPT(404.42,"ATMPT",SCTEAM,SCPT))

               IF 'SCPT

                   QUIT 

               Begin DoDot:1

 +2                SET SCPTA=0

 +3                FOR 

                       SET SCPTA=$ORDER(^SCPT(404.42,"ATMPT",SCTEAM,SCPT,SCPTA))

                       IF 'SCPTA

                           QUIT 

                       Begin DoDot:2

 +4                        SET SCPTA0=$GET(^SCPT(404.42,SCPTA,0))

 +5                        IF 'SCPTA0

                               QUIT 

 +6                        IF '$$DTCHK^SCAPU1(SCBEGIN,SCEND,SCINCL,$PIECE(SCPTA0,U,2),$PIECE(SCPTA0,U,9))

                               QUIT 

 +7                        DO BLD(.SCLIST,SCPTA,SCPTA0,.SCN)

                       End DoDot:2

               End DoDot:1

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

 +1       ;

 +2       ;

BLD(SCLIST,SCPTA,SCPTA0,SCN) ; build list

 +1       ;

 +2       ; SCPA    - ien of patient team assignment file #404.42

 +3       ; SCEFFDT - negative of effective date

 +4       ; SCN     - current subscript (counter) 1->n

 +5       ; SCPTA0   is 0 node of Patient Team Assignment file 1st piece is DFN

 +6       ; 

 +7       ; this builds the array:

 +8       ;   sclist(1->n)=sc2^ptname^effdt^inactdt

 +9       ;    for each scpta zero node passed to it

 +10      ;add error trapping?

           IF 'SCPTA!('SCPTA0)

               QUIT 

 +11       IF $DATA(@SCLIST@("SCPTA",+SCPTA0,SCPTA))

               QUIT 

 +12       IF $DATA(^TMP("SCMC",$JOB,"EXCLUDE PT","SCPTA",+SCPTA0))

               QUIT 

 +13       NEW SCEFFDT,SCCNT

 +14       SET SCN=SCN+1

 +15      ;S @SCLIST@(SCN)=+SCPTA0_U_$P($G(^DPT(+SCPTA0,0)),U,1)_U_SCPTA_U_$P(SCPTA0,U,2)_U_$P(SCPTA0,U,9)_U_$P($G(^DPT(+SCPTA0,.36)),U,3)

 +16      ;IHS/ANMC/LJF 11/2/2000

           SET @SCLIST@(SCN)=+SCPTA0_U_$PIECE($GET(^DPT(+SCPTA0,0)),U,1)_U_SCPTA_U_$PIECE(SCPTA0,U,2)_U_$PIECE(SCPTA0,U,9)_U_$$HRCN^BDGF2(+SCPTA0,+$GET(DUZ(2)))

 +17      ;_U_$P(SCPTA0,U,3)_U_$P($G(^SCTM(404.51,+$P(SCPTA0,U,3),0)),U,1) - didn't include team data to make return array generic

 +18       SET @SCLIST@("SCPTA",+SCPTA0,SCPTA,SCN)=""

 +19       QUIT 

OKDATA()  ;check/setup variables

 +1        NEW SCOK

 +2        SET SCOK=1

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

           DO INIT^SCAPMCU1(.SCOK)

 +4        IF '$DATA(^SCTM(404.51,+$GET(SCTEAM),0))

               Begin DoDot:1

 +5                SET SCPARM("TEAM")=$GET(SCTEAM,"Undefined")

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

               End DoDot:1

               SET SCOK=0

 +7       ; -- is it a valid TEAM ien passed (Error # 4045101 in DIALOG file)

 +8        IF '$DATA(^SCTM(404.51,+SCTEAM,0))

               Begin DoDot:1

 +9                SET SCPARM("TEAM")=SCTEAM

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

               End DoDot:1

               SET SCOK=0

 +11       QUIT SCOK