SCMCEV2 ;ALB/CMM - TEAM EVENT DRIVER UTILITIES ; 03/20/96
;;5.3;Scheduling;**41**;AUG 13, 1993
;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMCEV2 1906 printed Oct 16, 2024@18:40:52 Page 2
SCMCEV2 ;ALB/CMM - TEAM EVENT DRIVER UTILITIES ; 03/20/96
+1 ;;5.3;Scheduling;**41**;AUG 13, 1993
+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
