SCAPMC1.m

SCAPMC1 ;ALB/REW - Team API's: PRTM ; JUN 26, 1995

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

 ;;1.0

PRTM(SCTEAM,SCDATES,SCUSRA,SCROLEA,SCLIST,SCERR) ; -- practitioners for team

 ; 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 pracitioners who were on

 ;                       team for entire date range

 ;                     0: anytime in date range

 ;                      [default: 1] 

 ;  SCUSRA = array of usr classes to use/exclude

 ;           if $d(@scusra@('exclude')) -> list to exclude

 ;  SCROLEA = array of roles to use/exclude

 ;  SCERR = array NAME to store error messages.

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

 ; Output:

 ;  SCLIST() = array of practitioners

 ;             Format:

 ;               Subscript: Sequential # from 1 to n

 ;               Piece     Description

 ;                 1       IEN of NEW PERSON file entry (#200)

 ;                 2       Name of person

 ;                 3       IEN of TEAM POSITION file (#404.57)

 ;                 4       Name of Position

 ;                 5       IEN OF USR CLASS(#8930) of POSITION (#404.57)

 ;                 6       USR Class Name

 ;                 7       IEN of STANDARD POSITION (#403.46)

 ;                 8       Standard Role (Position) Name

 ;                 9       Activation Date for 404.52 (not 404.59!)

 ;                10       Inactivation Date for 404.52

 ;                11       IEN of Position Ass History (404.52)

 ;                12       IEN of Preceptor Position

 ;                13       Name of Preceptor Position

 ;

 ;  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 SCPOSNM,SCTP,SCPOS0,SCOK,SCND,SCU,SCR,SCPRTM

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

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

 ; -- loop through team positions

 S SCTP=0

 F  S SCTP=$O(^SCTM(404.57,"C",SCTEAM,SCTP)) Q:'SCTP  D

 .S SCND=$G(^SCTM(404.57,SCTP,0))

 .S SCU=$P(SCND,U,13)

 .Q:'$$OKUSRCL^SCAPU1(.SCUSRA,.SCU)

 .S SCR=$P(SCND,U,3)

 .Q:'$$OKARRAY^SCAPU1(.SCROLEA,.SCR)

 .Q:'$$ACTHIST^SCAPMCU2(404.52,SCTP,SCDATES,.SCERR,"SCPRTM")

 .Q:'$$PRTP^SCAPMC8(SCTP,SCDATES,.SCLIST,.SCERR)

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

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

 N SCOK

 S SCOK=1

 D INIT^SCAPMCU1(.SCOK) ; 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)

 Q SCOK

SCAPMC1   ;ALB/REW - Team API's: PRTM ; JUN 26, 1995

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

 +2       ;;1.0

PRTM(SCTEAM,SCDATES,SCUSRA,SCROLEA,SCLIST,SCERR) ; -- practitioners for team

 +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 pracitioners who were on

 +8       ;                       team for entire date range

 +9       ;                     0: anytime in date range

 +10      ;                      [default: 1] 

 +11      ;  SCUSRA = array of usr classes to use/exclude

 +12      ;           if $d(@scusra@('exclude')) -> list to exclude

 +13      ;  SCROLEA = array of roles to use/exclude

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

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

 +16      ; Output:

 +17      ;  SCLIST() = array of practitioners

 +18      ;             Format:

 +19      ;               Subscript: Sequential # from 1 to n

 +20      ;               Piece     Description

 +21      ;                 1       IEN of NEW PERSON file entry (#200)

 +22      ;                 2       Name of person

 +23      ;                 3       IEN of TEAM POSITION file (#404.57)

 +24      ;                 4       Name of Position

 +25      ;                 5       IEN OF USR CLASS(#8930) of POSITION (#404.57)

 +26      ;                 6       USR Class Name

 +27      ;                 7       IEN of STANDARD POSITION (#403.46)

 +28      ;                 8       Standard Role (Position) Name

 +29      ;                 9       Activation Date for 404.52 (not 404.59!)

 +30      ;                10       Inactivation Date for 404.52

 +31      ;                11       IEN of Position Ass History (404.52)

 +32      ;                12       IEN of Preceptor Position

 +33      ;                13       Name of Preceptor Position

 +34      ;

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

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

 +37      ;             Foramt:

 +38      ;               Subscript: Sequential # from 1 to n

 +39      ;               Piece     Description

 +40      ;                 1       IEN of DIALOG file

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

 +42      ;

 +43      ; -- initialize control variables

 +44      ;

ST         NEW SCPOSNM,SCTP,SCPOS0,SCOK,SCND,SCU,SCR,SCPRTM

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

 +2       ; setup/check variables

           IF '$$OKDATA

               GOTO PRACQ

 +3       ; -- loop through team positions

 +4        SET SCTP=0

 +5        FOR 

               SET SCTP=$ORDER(^SCTM(404.57,"C",SCTEAM,SCTP))

               IF 'SCTP

                   QUIT 

               Begin DoDot:1

 +6                SET SCND=$GET(^SCTM(404.57,SCTP,0))

 +7                SET SCU=$PIECE(SCND,U,13)

 +8                IF '$$OKUSRCL^SCAPU1(.SCUSRA,.SCU)

                       QUIT 

 +9                SET SCR=$PIECE(SCND,U,3)

 +10               IF '$$OKARRAY^SCAPU1(.SCROLEA,.SCR)

                       QUIT 

 +11               IF '$$ACTHIST^SCAPMCU2(404.52,SCTP,SCDATES,.SCERR,"SCPRTM")

                       QUIT 

 +12               IF '$$PRTP^SCAPMC8(SCTP,SCDATES,.SCLIST,.SCERR)

                       QUIT 

               End DoDot:1

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

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

 +1        NEW SCOK

 +2        SET SCOK=1

 +3       ; 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        QUIT SCOK