source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCMCEV2.m@ 1710

Last change on this file since 1710 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.8 KB
RevLine 
[613]1SCMCEV2 ;ALB/CMM - TEAM EVENT DRIVER UTILITIES ; 03/20/96
2 ;;5.3;Scheduling;**41**;AUG 13, 1993
3 ;
4ACT(DFN,TIEN) ; active team assignment
5 N ACTD,FND,ENT
6 S ACTD="",FND=0
7 F S ACTD=$O(^SCPT(404.42,"AIDT",DFN,TIEN,ACTD)) Q:ACTD=""!(FND) D
8 .S ENT=$O(^SCPT(404.42,"AIDT",DFN,TIEN,ACTD,""))
9 .Q:ENT=""
10 .I $P($G(^SCPT(404.42,ENT,0)),"^",9)="" S FND=1
11 Q FND
12 ;
13CHK(DFN,CLIEN,FLG) ;
14 ;check if auto enroll/discharge is appropriate
15 ;DFN - patient ien
16 ;EN1 - "DE" entry ien
17 ;CLIEN - clinic ien
18 ;FLG - add-1/del-2/both-3 flag
19 ;
20 ;RETURNS: 1^team ien = auto enroll/discharge
21 ; 0 - don't allow auto enroll/discharge
22 ;
23 N RETURN,LIST,ERR,OKAY,ACTIVE,TNODE,TIEN
24 S RETURN=0,LIST="TCLIST",ERR="ERR1"
25 K @LIST,@ERR
26 S OKAY=$$TMCL^SCAPMC16(CLIEN,"",.LIST,.ERR)
27 G:'OKAY EXIT
28 G:@LIST@(0)<0!(@LIST@(0)>1) EXIT
29 ;unique team
30 S TIEN=+$P($G(@LIST@(1)),"^")
31 I FLG=1!(FLG=3),$P($G(^SCTM(404.51,TIEN,0)),"^",11)'=1 G EXIT
32 I FLG=2!(FLG=3),$P($G(^SCTM(404.51,TIEN,0)),"^",12)'=1 G EXIT
33 ;auto enroll/discharge flag on to allow
34 S TNODE=$G(^SCTM(404.51,TIEN,0))
35 I $P(TNODE,"^",10)=1 G EXIT ;team close to future assignments
36 I $P(TNODE,"^",5)=1&($G(^DPT(DFN,"VET"))'="Y") G EXIT ;pc team but not vet
37 S ACTIVE=0
38 I $D(^SCPT(404.42,"AIDT",DFN,TIEN)) S ACTIVE=$$ACT(DFN,TIEN)
39 ;enrolled on team but is it still active
40 I ACTIVE&(FLG=1) G EXIT ;already enrolled
41 S RETURN="1^"_TIEN ;update/enroll
42EXIT ;
43 K @LIST,@ERR
44 Q RETURN
45 ;
46POSASS(DFN,TM) ;patient assigned to position on team TM
47 ;DFN - patient ien
48 ;TM - team ien
49 N PPLIST,ERR,OKAY,CNT,STOP
50 S STOP=0
51 S OKAY=$$TPPT^SCAPMC23(DFN,"","","","","","","PPLIST","ERR")
52 ;returns all positions patient assigned to today
53 Q:'OKAY -1
54 Q:'$D(PPLIST) 1 ;no associated positions
55 S CNT=0
56 F S CNT=$O(PPLIST(CNT)) Q:CNT=""!(CNT'?.N)!(STOP) D
57 .I +$P($G(PPLIST(CNT)),"^",3)=TM S STOP=1
58 I 'STOP Q 1
59 Q 0
Note: See TracBrowser for help on using the repository browser.