| [613] | 1 | SCMCTMU2 ;ALB/REW - Team-Patient Utilities ; 1 Apr 96
|
|---|
| 2 | ;;5.3;Scheduling;**41,51,148**;AUG 13, 1993
|
|---|
| 3 | ;1
|
|---|
| 4 | RESTENR ;call when pt is set to 'restrict consults' & he is enrolled in clinic
|
|---|
| 5 | G:'$G(DFN) END
|
|---|
| 6 | S SCCL=0
|
|---|
| 7 | F S SCCL=$O(^TMP($J,"SC CED","AFTER","B",SCCL)) Q:'SCCL D
|
|---|
| 8 | .W !,SCCL
|
|---|
| 9 | END Q
|
|---|
| 10 | ;
|
|---|
| 11 | YSPTTMPC(DFN,SCACT) ;is it ok to give patient a new pc team?
|
|---|
| 12 | ; Return [OK:1,Not OK: 0^Message]
|
|---|
| 13 | N SCOK,SCX,SCTM
|
|---|
| 14 | ;does pt have a current pc team?
|
|---|
| 15 | S SCTM=$$GETPCTM^SCAPMCU2(DFN,DT,1)
|
|---|
| 16 | IF SCTM>0 S SCOK="0^Pt has current PC Team Assignment"_U_SCTM G QTOKPC
|
|---|
| 17 | ;does pt have a future pc team?
|
|---|
| 18 | S SCX=$O(^SCPT(404.42,"APCTM",DFN,1,SCACT))
|
|---|
| 19 | IF SCX D G QTOKPC
|
|---|
| 20 | .S SCTM=$O(^SCPT(404.42,"APCTM",DFN,1,+SCX,0))
|
|---|
| 21 | .S SCOK="0^Patient has future PC Assignment to the "_$P($G(^SCTM(404.51,+SCTM,0)),U,1)_" team."_U_SCTM
|
|---|
| 22 | S SCOK=1
|
|---|
| 23 | QTOKPC Q SCOK
|
|---|
| 24 | ;
|
|---|
| 25 | OKACPTTM(DFN,SCTM,SCDATE,SCACTIVE) ;is patient active from now till forever?
|
|---|
| 26 | ; Returned: 1: Not active from now till forever, 0 = Active sometime
|
|---|
| 27 | ; DFN - Pointer to Patient File
|
|---|
| 28 | ; SCTM - Team File ien of interest
|
|---|
| 29 | ; SCDATE - Start Date
|
|---|
| 30 | ; SCACTIVE- Must Team be active on date or just sometime in future?
|
|---|
| 31 | N SCTMDT,SCOK,SCACERR,SCACLST
|
|---|
| 32 | S SCOK=1
|
|---|
| 33 | S SCTMDT("BEGIN")=$G(SCDATE,DT)
|
|---|
| 34 | S SCTMDT("END")=3990101 ;forever
|
|---|
| 35 | S SCTMDT("INCL")=0
|
|---|
| 36 | S SCACTIVE=$G(SCACTIVE,1)
|
|---|
| 37 | ; if checking for active teams
|
|---|
| 38 | IF SCACTIVE&('$$ACTHIST^SCAPMCU2(404.58,.SCTM,.SCTMDT,"SCACERR","SCACLST")) S SCOK=0 G ENDOKTM
|
|---|
| 39 | S SCOK=$$TMPT^SCAPMC(DFN,"SCTMDT",,"SCACLST","SCACERR")
|
|---|
| 40 | S:SCOK>0&($D(SCACLST("SCTM",SCTM))) SCOK=0
|
|---|
| 41 | ENDOKTM Q SCOK
|
|---|
| 42 | ;
|
|---|
| 43 | OKPTTMPC(DFN,SCTM,DATE) ;
|
|---|
| 44 | N SCOK,SCPCTM
|
|---|
| 45 | S SCOK=1
|
|---|
| 46 | ;is this a possible pc team?
|
|---|
| 47 | IF '$P($G(^SCTM(404.51,+$G(SCTM),0)),U,5) S SCOK=0 G QTOKTM
|
|---|
| 48 | S SCPCTM=$$GETPCTM^SCAPMCU2(DFN,DATE,1)
|
|---|
| 49 | IF SCPCTM D G QTOKTM
|
|---|
| 50 | .IF SCPCTM'=SCTM D
|
|---|
| 51 | ..S SCOK=0
|
|---|
| 52 | ELSE D
|
|---|
| 53 | .S SCOK=$$YSPTTMPC(DFN,DATE)
|
|---|
| 54 | QTOKTM Q SCOK
|
|---|
| 55 | ;
|
|---|
| 56 | OKINPTTM(DFN,SCTM,SCINACT) ;no future pt-position assignments?
|
|---|
| 57 | Q:'($G(DFN)&($G(SCTM))&($G(SCINACT))) 0
|
|---|
| 58 | N SCTP,SCPTTPDT,SCPTTPI,SCPTTP0,OK
|
|---|
| 59 | S SCTP=0,OK=1
|
|---|
| 60 | F S SCTP=$O(^SCPT(404.43,"ADFN",DFN,SCTP)) Q:'SCTP D Q:'OK
|
|---|
| 61 | .F SCPTTPDT=0:0 S SCPTTPDT=$O(^SCPT(404.43,"ADFN",DFN,SCTP,SCPTTPDT)) Q:'SCPTTPDT D
|
|---|
| 62 | ..S SCPTTPI=$O(^SCPT(404.43,"ADFN",DFN,SCTP,SCPTTPDT,0))
|
|---|
| 63 | ..S SCPTTP0=$G(^SCPT(404.43,SCPTTPI,0))
|
|---|
| 64 | ..Q:$P($G(^SCTM(404.57,+$P(SCPTTP0,U,2),0)),U,2)'=SCTM ;ignore other teams
|
|---|
| 65 | ..S:'$P(SCPTTP0,U,4) OK=0 ;all ptpos assignments must have inact date
|
|---|
| 66 | ..S:$P(SCPTTP0,U,4)>SCINACT OK=0 ;all ptpos inact dates after tm inact
|
|---|
| 67 | Q OK
|
|---|
