SCAPMC5.m

SCAPMC5 ;ALB/REW - Team API's:TMAU ; JUL 3, 1995

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

 ;;1.0

TMAU(SCAU,SCDATES,SCPURPA,SCLIST,SCERR) ; -- list of teams for autolink

 ; input:

 ;  SCAU = variable pointer to TEAM AUTOLINK file (#404.56)

 ;         e.g. 10866;VA(200 for the practitioner with duz=10866

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

 ;                      [default: TODAY]

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

 ;                      [default: TODAY]

 ;        ("INCL")  = 1: only use teams who were active

 ;                       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

 ;

ST N SCTM,SCTM0,SCPRP,SCTMAU

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

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

 ;

 ; -- loop through autolink assignments

 S SCTM=0

 F  S SCTM=$O(^SCTM(404.56,"AC",SCAU,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,"SCTMAU")

 .IF ACTHIST>0 D

 ..Q:$D(@SCLIST@("SCTM",SCTM,$P(ACTHIST,U,3)))

 ..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_$P(ACTHIST,U,3,4)

 ..S @SCLIST@("SCTM",SCTM,$P(ACTHIST,U,3),SCN)=""

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

OKDATA() ;check/setup variables

 N SCOK

 S SCOK=1

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

 IF '$D(^SCTM(404.56,"AC",SCAU)) D  S SCOK=0

 . S SCPARM("AUTOLINK")=SCAU

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

 ; -- is it a valid SCAU passed (Error # 4045601 in DIALOG file)

 Q SCOK

SCAPMC5   ;ALB/REW - Team API's:TMAU ; JUL 3, 1995

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

 +2       ;;1.0

TMAU(SCAU,SCDATES,SCPURPA,SCLIST,SCERR) ; -- list of teams for autolink

 +1       ; input:

 +2       ;  SCAU = variable pointer to TEAM AUTOLINK file (#404.56)

 +3       ;         e.g. 10866;VA(200 for the practitioner with duz=10866

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

 +5       ;                      [default: TODAY]

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

 +7       ;                      [default: TODAY]

 +8       ;        ("INCL")  = 1: only use teams who were active

 +9       ;                       for entire date range

 +10      ;                    0: anytime in date range

 +11      ;                      [default: 1] 

 +12      ;  SCPURPA -array of pointers to team purpose file 403.47

 +13      ;          if none are defined - returns all teams

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

 +15      ;  SCLIST -array name to store list

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

 +17      ;        

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

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

 +20      ;

 +21      ; Output:

 +22      ;  SCLIST() = array of teams

 +23      ;             Format:

 +24      ;               Subscript: Sequential # from 1 to n

 +25      ;               Piece     Description

 +26      ;                 1       IEN of TEAM file entry

 +27      ;                 2       Name of team

 +28      ;                 3       current effective date

 +29      ;                 4       current inactivate date (if any)

 +30      ;

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

 +32      ;             Foramt:

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

 +34      ;               Subscript: Sequential # from 1 to n

 +35      ;               Piece     Description

 +36      ;                 1       IEN of DIALOG file

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

 +38      ;

ST         NEW SCTM,SCTM0,SCPRP,SCTMAU

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

 +2       ;check/setup variables

           IF '$$OKDATA

               GOTO PRACQ

 +3       ;

 +4       ; -- loop through autolink assignments

 +5        SET SCTM=0

 +6        FOR 

               SET SCTM=$ORDER(^SCTM(404.56,"AC",SCAU,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,"SCTMAU")

 +12               IF ACTHIST>0

                       Begin DoDot:2

 +13                       IF $DATA(@SCLIST@("SCTM",SCTM,$PIECE(ACTHIST,U,3)))

                               QUIT 

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

 +15                       SET @SCLIST@(0)=SCN

 +16                       SET @SCLIST@(SCN)=SCTM_U_$PIECE(^SCTM(404.51,SCTM,0),U,1)_U_$PIECE(ACTHIST,U,3,4)

 +17                       SET @SCLIST@("SCTM",SCTM,$PIECE(ACTHIST,U,3),SCN)=""

                       End DoDot:2

               End DoDot:1

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

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.56,"AC",SCAU))

               Begin DoDot:1

 +5                SET SCPARM("AUTOLINK")=SCAU

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

               End DoDot:1

               SET SCOK=0

 +7       ; -- is it a valid SCAU passed (Error # 4045601 in DIALOG file)

 +8        QUIT SCOK