60 lines
1.8 KiB
Mathematica
60 lines
1.8 KiB
Mathematica
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
|