SCMCEV2.m

SCMCEV2 ;ALB/CMM - TEAM EVENT DRIVER UTILITIES ; 03/20/96

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

 ;

ACT(DFN,TIEN) ; active team assignment

 N ACTD,FND,ENT

 S ACTD="",FND=0

 F  S ACTD=$O(^SCPT(404.42,"AIDT",DFN,TIEN,ACTD)) Q:ACTD=""!(FND)  D

 .S ENT=$O(^SCPT(404.42,"AIDT",DFN,TIEN,ACTD,""))

 .Q:ENT=""

 .I $P($G(^SCPT(404.42,ENT,0)),"^",9)="" S FND=1

 Q FND

 ;

CHK(DFN,CLIEN,FLG) ;

 ;check if auto enroll/discharge is appropriate

 ;DFN - patient ien

 ;EN1 - "DE" entry ien

 ;CLIEN - clinic ien

 ;FLG - add-1/del-2/both-3 flag

 ;

 ;RETURNS: 1^team ien = auto enroll/discharge

 ;         0 - don't allow auto enroll/discharge

 ;

 N RETURN,LIST,ERR,OKAY,ACTIVE,TNODE,TIEN

 S RETURN=0,LIST="TCLIST",ERR="ERR1"

 K @LIST,@ERR

 S OKAY=$$TMCL^SCAPMC16(CLIEN,"",.LIST,.ERR)

 G:'OKAY EXIT

 G:@LIST@(0)<0!(@LIST@(0)>1) EXIT

 ;unique team

 S TIEN=+$P($G(@LIST@(1)),"^")

 I FLG=1!(FLG=3),$P($G(^SCTM(404.51,TIEN,0)),"^",11)'=1 G EXIT

 I FLG=2!(FLG=3),$P($G(^SCTM(404.51,TIEN,0)),"^",12)'=1 G EXIT

 ;auto enroll/discharge flag on to allow

 S TNODE=$G(^SCTM(404.51,TIEN,0))

 I $P(TNODE,"^",10)=1 G EXIT ;team close to future assignments

 I $P(TNODE,"^",5)=1&($G(^DPT(DFN,"VET"))'="Y") G EXIT ;pc team but not vet

 S ACTIVE=0

 I $D(^SCPT(404.42,"AIDT",DFN,TIEN)) S ACTIVE=$$ACT(DFN,TIEN)

 ;enrolled on team but is it still active

 I ACTIVE&(FLG=1) G EXIT ;already enrolled

 S RETURN="1^"_TIEN ;update/enroll

EXIT ;

 K @LIST,@ERR

 Q RETURN

 ;

POSASS(DFN,TM) ;patient assigned to position on team TM

 ;DFN - patient ien

 ;TM - team ien

 N PPLIST,ERR,OKAY,CNT,STOP

 S STOP=0

 S OKAY=$$TPPT^SCAPMC23(DFN,"","","","","","","PPLIST","ERR")

 ;returns all positions patient assigned to today

 Q:'OKAY -1

 Q:'$D(PPLIST) 1  ;no associated positions

 S CNT=0

 F  S CNT=$O(PPLIST(CNT)) Q:CNT=""!(CNT'?.N)!(STOP)  D

 .I +$P($G(PPLIST(CNT)),"^",3)=TM S STOP=1

 I 'STOP Q 1

 Q 0

SCMCEV2   ;ALB/CMM - TEAM EVENT DRIVER UTILITIES ; 03/20/96

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

 +2       ;

ACT(DFN,TIEN) ; active team assignment

 +1        NEW ACTD,FND,ENT

 +2        SET ACTD=""

           SET FND=0

 +3        FOR 

               SET ACTD=$ORDER(^SCPT(404.42,"AIDT",DFN,TIEN,ACTD))

               IF ACTD=""!(FND)

                   QUIT 

               Begin DoDot:1

 +4                SET ENT=$ORDER(^SCPT(404.42,"AIDT",DFN,TIEN,ACTD,""))

 +5                IF ENT=""

                       QUIT 

 +6                IF $PIECE($GET(^SCPT(404.42,ENT,0)),"^",9)=""

                       SET FND=1

               End DoDot:1

 +7        QUIT FND

 +8       ;

CHK(DFN,CLIEN,FLG) ;

 +1       ;check if auto enroll/discharge is appropriate

 +2       ;DFN - patient ien

 +3       ;EN1 - "DE" entry ien

 +4       ;CLIEN - clinic ien

 +5       ;FLG - add-1/del-2/both-3 flag

 +6       ;

 +7       ;RETURNS: 1^team ien = auto enroll/discharge

 +8       ;         0 - don't allow auto enroll/discharge

 +9       ;

 +10       NEW RETURN,LIST,ERR,OKAY,ACTIVE,TNODE,TIEN

 +11       SET RETURN=0

           SET LIST="TCLIST"

           SET ERR="ERR1"

 +12       KILL @LIST,@ERR

 +13       SET OKAY=$$TMCL^SCAPMC16(CLIEN,"",.LIST,.ERR)

 +14       IF 'OKAY

               GOTO EXIT

 +15       IF @LIST@(0)<0!(@LIST@(0)>1)

               GOTO EXIT

 +16      ;unique team

 +17       SET TIEN=+$PIECE($GET(@LIST@(1)),"^")

 +18       IF FLG=1!(FLG=3)

               IF $PIECE($GET(^SCTM(404.51,TIEN,0)),"^",11)'=1

                   GOTO EXIT

 +19       IF FLG=2!(FLG=3)

               IF $PIECE($GET(^SCTM(404.51,TIEN,0)),"^",12)'=1

                   GOTO EXIT

 +20      ;auto enroll/discharge flag on to allow

 +21       SET TNODE=$GET(^SCTM(404.51,TIEN,0))

 +22      ;team close to future assignments

           IF $PIECE(TNODE,"^",10)=1

               GOTO EXIT

 +23      ;pc team but not vet

           IF $PIECE(TNODE,"^",5)=1&($GET(^DPT(DFN,"VET"))'="Y")

               GOTO EXIT

 +24       SET ACTIVE=0

 +25       IF $DATA(^SCPT(404.42,"AIDT",DFN,TIEN))

               SET ACTIVE=$$ACT(DFN,TIEN)

 +26      ;enrolled on team but is it still active

 +27      ;already enrolled

           IF ACTIVE&(FLG=1)

               GOTO EXIT

 +28      ;update/enroll

           SET RETURN="1^"_TIEN

EXIT      ;

 +1        KILL @LIST,@ERR

 +2        QUIT RETURN

 +3       ;

POSASS(DFN,TM) ;patient assigned to position on team TM

 +1       ;DFN - patient ien

 +2       ;TM - team ien

 +3        NEW PPLIST,ERR,OKAY,CNT,STOP

 +4        SET STOP=0

 +5        SET OKAY=$$TPPT^SCAPMC23(DFN,"","","","","","","PPLIST","ERR")

 +6       ;returns all positions patient assigned to today

 +7        IF 'OKAY

               QUIT -1

 +8       ;no associated positions

           IF '$DATA(PPLIST)

               QUIT 1

 +9        SET CNT=0

 +10       FOR 

               SET CNT=$ORDER(PPLIST(CNT))

               IF CNT=""!(CNT'?.N)!(STOP)

                   QUIT 

               Begin DoDot:1

 +11               IF +$PIECE($GET(PPLIST(CNT)),"^",3)=TM

                       SET STOP=1

               End DoDot:1

 +12       IF 'STOP

               QUIT 1

 +13       QUIT 0