| 1 | SCMCEV1 ;ALB/CMM - TEAM EVENT DRIVER UTILITIES ; 03/20/96
|
|---|
| 2 | ;;5.3;Scheduling;**41,130,140**;AUG 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | ENROLL(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 | ;
|
|---|
| 33 | UPDATE(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 | ;
|
|---|
| 68 | DELT(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 | ;
|
|---|
| 90 | DELTE(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
|
|---|
| 102 | EXD Q RET
|
|---|
