source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCMCEV1.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: 3.1 KB
RevLine 
[613]1SCMCEV1 ;ALB/CMM - TEAM EVENT DRIVER UTILITIES ; 03/20/96
2 ;;5.3;Scheduling;**41,130,140**;AUG 13, 1993
3 ;
4ENROLL(DFN,TIEN,ENDATE,DISDATE,CNAME) ;
5 ;enroll DFN patient in team TIEN
6 ;DFN - patient ien
7 ;TIEN - team ien
8 ;ENDATE - clinic enrollment date
9 ;DISDATE - clinic discharge date
10 ;CNAME - clinic name
11 ;
12 N OKAY,ERR,PUR,SC,SCERR,TNAME,TEXT
13 S TNAME=$P($G(^SCTM(404.51,TIEN,0)),"^") ;team name
14 S OKAY=$$ACPTTM^SCAPMC6(DFN,TIEN,,ENDATE,"ERR")
15 I OKAY=0 Q
16 ;okay = ien of 404.42
17 S PUR(1,0)="Automatic Team Enrollment/Update via Clinic: "_CNAME
18 I '$D(SCERR) D
19 .D WP^DIE(404.42,+OKAY_",","1","A","PUR","SCERR")
20 .S TEXT="Enrolled in Team: "_TNAME
21 .D:'$G(DGQUIET) EN^DDIOL(TEXT,"","!,?10")
22 K SCERR,ERR
23 I $D(DISDATE) D
24 .S PUR(1,0)="Automatic Team Discharge via Clinic: "_CNAME
25 .Q:'$$POSASS^SCMCEV2(DFN,TIEN)
26 .S OKAY=$$INPTTM^SCAPMC7(DFN,TIEN,DISDATE,"ERR")
27 .I OKAY'=0 D
28 ..D WP^DIE(404.42,+OKAY_",","1","A","PUR","SCERR")
29 ..S TEXT="Discharged from Team: "_TNAME
30 ..D:'$G(DGQUIET) EN^DDIOL(TEXT,"","!,?10")
31 Q
32 ;
33UPDATE(DFN,TIEN,EDATE,DDATE,CNAME) ;
34 ;update enrollment date/discharge date
35 ;DFN - patient ien
36 ;TIEN - team ien
37 ;EDATE - enrollment date
38 ;DDATE - discharge date
39 ;CNAME - clinic name
40 ;
41 N TPA,TDATE,TEXT,TNAME
42 S TNAME=$P($G(^SCTM(404.51,TIEN,0)),"^") ;team name
43 I '$D(^SCPT(404.42,"AIDT",DFN,TIEN)) D ENROLL(TIEN,DFN,EDATE,DDATE,CNAME) Q
44 ; ^ new enrollment
45 S TDATE=$O(^SCPT(404.42,"AIDT",DFN,TIEN,"")) ; -team assignment date (most recent)
46 S TPA=$O(^SCPT(404.42,"AIDT",DFN,TIEN,TDATE,"")) ; team assignment ien
47 Q:'$D(^SCPT(404.42,+TPA,0))
48 K SC($J,404.42),SCERR
49 I EDATE'=0 D
50 .S SC($J,404.42,TPA_",",.13)=DUZ
51 .S SC($J,404.42,TPA_",",.14)=DT
52 .S SC($J,404.42,TPA_",",.02)=$P(EDATE,".") ;date only
53 .D FILE^DIE("","SC($J)","SCERR")
54 .S PUR(1,0)="Automatic Team Update via Clinic: "_CNAME
55 .D WP^DIE(404.42,TPA_",","1","A","PUR","SCERR")
56 .S TEXT="Update Team Enrollment "_TNAME
57 .D:'$G(DGQUIET) EN^DDIOL(TEXT,"","!,?10")
58 I +DDATE'=0 D
59 .Q:'$$POSASS^SCMCEV2(DFN,TIEN)
60 .; ^ assigned to a position
61 .S OKAY=$$INPTTM^SCAPMC7(DFN,TPA,DDATE,"ERR") ; discharge from team
62 .I OKAY'=0 D
63 ..D WP^DIE(404.42,+OKAY_",","1","A","PUR","SCERR")
64 ..S TEXT="Discharged from Team: "_TNAME
65 ..D:'$G(DGQUIET) EN^DDIOL(TEXT,"","!,?10")
66 Q
67 ;
68DELT(DFN,CLN) ;deleted clinic entry/enrollment date w/'@'
69 ;DFN - patient ien
70 ;CLN - clinic ien
71 ;
72 N CHECK,TM,EDATE,OKAY,CNAME,ERR,TEXT,TNAME
73 S CNAME=$P($G(^SC(+CLN,0)),"^") ;clinic name
74 S CHECK=$$CHK^SCMCEV2(DFN,CLN,2)
75 ; ^ auto discharge okay
76 Q:'+CHECK
77 ;check if assigned to a position on team
78 S TM=+$P(CHECK,"^",2) ;team ien
79 S OKAY=$$POSASS^SCMCEV2(DFN,TM)
80 Q:'OKAY
81 ;delete entry
82 S ERR=$$DELTE(DFN,TM)
83 I ERR D
84 .;deleted entry
85 .S TNAME=$P($G(^SCTM(404.51,TM,0)),"^") ;team name
86 .S TEXT="Deleted team "_TNAME_" assignment due to deleting clinic assignment"
87 .D:'$G(DGQUIET) EN^DDIOL(TEXT,"","!,?10")
88 Q
89 ;
90DELTE(DFN,TIEN) ;delete team assignment entry
91 ;DFN - patient ien
92 ;TIEN - team ien
93 N PTA,ADATE,RET
94 S RET=1
95 S ADATE=$O(^SCPT(404.42,"AIDT",DFN,TIEN,-($$FMADD^XLFDT(DT,1))))
96 I ADATE="" S RET=0 G EXD
97 S PTA=$O(^SCPT(404.42,"AIDT",DFN,TIEN,ADATE,""))
98 I PTA="" S RET=0 G EXD
99 S DA=PTA,DIK="^SCPT(404.42,"
100 D ^DIK
101 K DA,DIK
102EXD Q RET
Note: See TracBrowser for help on using the repository browser.