SCAPMC4.m

SCAPMC4 ;ALB/REW - Team API's:TMINST ; JUN 30, 1995

 ;;5.3;Scheduling;**41**;AUG 13, 1993

 ;;1.0

TMINST(SCINST,SCDATES,SCPURPA,SCLIST,SCERR) ; -- list of teams for institution

 ; input:

 ;  SCINST = ien of INSTITUTION file (#4)

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

 ;  SCPURPA -array of pointers to team purpose file 403.47

 ;          if none are defined - returns all teams

 ;          if @SCPURPA@('exclude') is defined - exclude listed teams

 ;  SCLIST -array name to store list

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

 ;        

 ;  SCERR = array NAME to store error messages.

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

 ;

 ; Output:

 ;  SCLIST() = array of teams

 ;             Format:

 ;               Subscript: Sequential # from 1 to n

 ;               Piece     Description

 ;                 1       IEN of TEAM file entry

 ;                 2       Name of team

 ;                 3       current effective date

 ;                 4       current inactivate date (if any)

 ;

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

 ;             Foramt:

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

 ;               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 SCTM,SCTM0,SCX,SCPRP,SCTMINST

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

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

 ;

 ; -- loop through teams for institution

 S SCTM=0

 F  S SCTM=$O(^SCTM(404.51,"AINST",SCINST,SCTM)) Q:'SCTM  D

 .S SCTM0=$G(^SCTM(404.51,SCTM,0))

 .Q:SCTM0=""

 .S SCPRP=$P(SCTM0,U,3)

 .Q:'$$OKARRAY^SCAPU1(.SCPURPA,SCPRP)

 .S ACTHIST=$$ACTHIST^SCAPMCU2(404.58,SCTM,SCDATES,.SCERR,"SCTMINST")

 .Q:ACTHIST'>0

 .D BLDTM(SCTM,SCDATES,ACTHIST,.SCLIST,.SCERR)

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

 ;

BLDTM(SCTM,SCDATES,ACTHIST,SCLIST,SCERR) ;build team list

 ; ACTHIST is per $$acthist - dates may be tighter than team activation

 ;      e.g. practitioners' dates will be dates they not team is active

 N SCACT,SCINACT

 S SCACT=+$P(ACTHIST,U,3)

 Q:'SCACT

 S SCINACT=@SCDATES@("END")

 S SCINACT=$S('SCINACT:$P(ACTHIST,U,4),'$P(ACTHIST,U,4):SCINACT,(SCINACT<$P(ACTHIST,U,4)):SCINACT,1:$P(ACTHIST,U,4))

 Q:$D(@SCLIST@("SCTM",SCTM,SCACT))

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

 S @SCLIST@(0)=SCN

 S @SCLIST@(SCN)=SCTM_U_$P(^SCTM(404.51,SCTM,0),U,1)_U_SCACT_U_SCINACT

 S @SCLIST@("SCTM",SCTM,SCACT,SCN)=""

 Q

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(^DIC(4,+$G(SCINST),0)) D  S SCOK=0

 . S SCPARM("INSTITUTION")=$G(SCINST,"Undefined")

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

 Q SCOK

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SCAPMC4   3176     printed  Apr 09, 2024@21:52:52                                                                                                                                                                                                     Page 2

SCAPMC4   ;ALB/REW - Team API's:TMINST ; JUN 30, 1995

 +1       ;;5.3;Scheduling;**41**;AUG 13, 1993

 +2       ;;1.0

TMINST(SCINST,SCDATES,SCPURPA,SCLIST,SCERR) ; -- list of teams for institution

 +1       ; input:

 +2       ;  SCINST = ien of INSTITUTION file (#4)

 +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      ;  SCPURPA -array of pointers to team purpose file 403.47

 +12      ;          if none are defined - returns all teams

 +13      ;          if @SCPURPA@('exclude') is defined - exclude listed teams

 +14      ;  SCLIST -array name to store list

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

 +16      ;        

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

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

 +19      ;

 +20      ; Output:

 +21      ;  SCLIST() = array of teams

 +22      ;             Format:

 +23      ;               Subscript: Sequential # from 1 to n

 +24      ;               Piece     Description

 +25      ;                 1       IEN of TEAM file entry

 +26      ;                 2       Name of team

 +27      ;                 3       current effective date

 +28      ;                 4       current inactivate date (if any)

 +29      ;

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

 +31      ;             Foramt:

 +32      ;  @SCERR@(0) = Number of errors, undefined if none

 +33      ;               Subscript: Sequential # from 1 to n

 +34      ;               Piece     Description

 +35      ;                 1       IEN of DIALOG file

 +36      ;

 +37      ;

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

 +39      ;

 +40      ; -- initialize control variables

ST         NEW SCTM,SCTM0,SCX,SCPRP,SCTMINST

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

 +2       ;check/setup variables

           if '$$OKDATA

               GOTO PRACQ

 +3       ;

 +4       ; -- loop through teams for institution

 +5        SET SCTM=0

 +6        FOR 

               SET SCTM=$ORDER(^SCTM(404.51,"AINST",SCINST,SCTM))

               if 'SCTM

                   QUIT 

               Begin DoDot:1

 +7                SET SCTM0=$GET(^SCTM(404.51,SCTM,0))

 +8                if SCTM0=""

                       QUIT 

 +9                SET SCPRP=$PIECE(SCTM0,U,3)

 +10               if '$$OKARRAY^SCAPU1(.SCPURPA,SCPRP)

                       QUIT 

 +11               SET ACTHIST=$$ACTHIST^SCAPMCU2(404.58,SCTM,SCDATES,.SCERR,"SCTMINST")

 +12               if ACTHIST'>0

                       QUIT 

 +13               DO BLDTM(SCTM,SCDATES,ACTHIST,.SCLIST,.SCERR)

               End DoDot:1

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

 +1       ;

BLDTM(SCTM,SCDATES,ACTHIST,SCLIST,SCERR) ;build team list

 +1       ; ACTHIST is per $$acthist - dates may be tighter than team activation

 +2       ;      e.g. practitioners' dates will be dates they not team is active

 +3        NEW SCACT,SCINACT

 +4        SET SCACT=+$PIECE(ACTHIST,U,3)

 +5        if 'SCACT

               QUIT 

 +6        SET SCINACT=@SCDATES@("END")

 +7        SET SCINACT=$SELECT('SCINACT:$PIECE(ACTHIST,U,4),'$PIECE(ACTHIST,U,4):SCINACT,(SCINACT<$PIECE(ACTHIST,U,4)):SCINACT,1:$PIECE(ACTHIST,U,4))

 +8        if $DATA(@SCLIST@("SCTM",SCTM,SCACT))

               QUIT 

 +9        SET SCN=$GET(@SCLIST@(0),0)+1

 +10       SET @SCLIST@(0)=SCN

 +11       SET @SCLIST@(SCN)=SCTM_U_$PIECE(^SCTM(404.51,SCTM,0),U,1)_U_SCACT_U_SCINACT

 +12       SET @SCLIST@("SCTM",SCTM,SCACT,SCN)=""

 +13       QUIT 

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(^DIC(4,+$GET(SCINST),0))

               Begin DoDot:1

 +5                SET SCPARM("INSTITUTION")=$GET(SCINST,"Undefined")

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

               End DoDot:1

               SET SCOK=0

 +7        QUIT SCOK