| 1 | SCMCTPU2 ;ALB/REW - Team Position Utilities ; 9 Jun 1995
|
|---|
| 2 | ;;5.3;Scheduling;**41,148,204**;AUG 13, 1993
|
|---|
| 3 | ;1
|
|---|
| 4 | YSPTTPPC(DFN,SCACT,SCROLE) ;is it ok to give patient a new pc position
|
|---|
| 5 | ;
|
|---|
| 6 | ; Return [OK:1,Not OK: 0^Message]
|
|---|
| 7 | Q:"2^1"'[$G(SCROLE) "0^Bad PC Role"
|
|---|
| 8 | N SCOK,SCX,SCTP,SCROLETX
|
|---|
| 9 | S SCROLETX=$S(SCROLE=1:"Practitioner",(SCROLE=2):"Attending",1:"Error")
|
|---|
| 10 | ;does pt have a current pc position?
|
|---|
| 11 | S SCTP=$$GETPCTP^SCAPMCU2(DFN,DT,SCROLE)
|
|---|
| 12 | IF SCTP>0 S SCOK="0^Pt has current PC "_SCROLETX_" Position Assignment"_U_SCTP G QTOKPC
|
|---|
| 13 | ;does pt have a future pc position?
|
|---|
| 14 | S SCX=$O(^SCPT(404.43,"APCPOS",DFN,SCROLE,SCACT))
|
|---|
| 15 | IF SCX D G QTOKPC
|
|---|
| 16 | .S SCTP=$O(^SCPT(404.43,"APCPOS",DFN,SCROLE,+SCX,0))
|
|---|
| 17 | .S SCOK="0^Patient has future PC Assignment to the "_$P($G(^SCTM(404.57,+SCTP,0)),U,1)_" position."_U_SCTP
|
|---|
| 18 | S SCOK=1
|
|---|
| 19 | QTOKPC Q SCOK
|
|---|
| 20 | ;
|
|---|
| 21 | OKACPTTP(DFN,SCTP,DATE,ACTIVE) ;is it ok to activate pt pos assignment?
|
|---|
| 22 | N SCOK,SCDT,SCNODE,SCINACT
|
|---|
| 23 | S SCOK=1
|
|---|
| 24 | G:'$D(^SCPT(404.43,"ADFN",DFN)) ENDOK ;quick check
|
|---|
| 25 | ;is position active now(if checking)?
|
|---|
| 26 | IF $G(ACTIVE) D G:'SCOK ENDOK
|
|---|
| 27 | . S SCOK=+$$ACTTP^SCMCTPU(SCTP,DATE)
|
|---|
| 28 | ;is the patient assigned to this position either now or in future?
|
|---|
| 29 | S SCDT=$O(^SCPT(404.43,"ADFN",DFN,SCTP,3990101),-1)
|
|---|
| 30 | S SCPTTP=$O(^SCPT(404.43,"ADFN",DFN,SCTP,+SCDT,0))
|
|---|
| 31 | IF SCPTTP D
|
|---|
| 32 | .S SCNODE=$G(^SCPT(404.43,SCPTTP,0))
|
|---|
| 33 | .S SCINACT=$P(SCNODE,U,4)
|
|---|
| 34 | .IF ('SCINACT)!(SCINACT>DATE) D
|
|---|
| 35 | ..S SCOK=0 ;no inactive date or inact after date
|
|---|
| 36 | ENDOK Q SCOK
|
|---|
| 37 | ;
|
|---|
| 38 | PCRLPTTP(DFN,SCTP,DATE) ; can position be pc practitioner or pc attending
|
|---|
| 39 | ; return yes pract^yes attend
|
|---|
| 40 | Q $$CHKROLE(DFN,SCTP,DATE,1)_U_$$CHKROLE(DFN,SCTP,DATE,2)
|
|---|
| 41 | ;
|
|---|
| 42 | CHKROLE(DFN,SCTP,DATE,ROLE) ;can position file role for patient?
|
|---|
| 43 | ;this is not a stand-alone function
|
|---|
| 44 | N SCCUR,SCDT,SCTPRL,SCPTTP,SCOK,SCNODE,SCINACT,SCACT
|
|---|
| 45 | S SCOK=1
|
|---|
| 46 | ;bp/cmf 204 change code begin
|
|---|
| 47 | ;original code next line
|
|---|
| 48 | ;IF $G(ROLE)&('$P($G(^SCTM(404.57,+$G(SCTP),0)),U,4)) S SCOK=0 G QTCHKRL
|
|---|
| 49 | ;bp/cmf 204 new code begin
|
|---|
| 50 | ;bp/cmf 204 new code end
|
|---|
| 51 | I $G(ROLE) D G:SCOK=0 QTCHKRL
|
|---|
| 52 | . I '$P($G(^SCTM(404.57,+$G(SCTP),0)),U,4) S SCOK=0 Q
|
|---|
| 53 | . N SCTM
|
|---|
| 54 | . S SCTM=$P($G(^SCTM(404.57,SCTP,0)),U,2)
|
|---|
| 55 | . I $P($G(^SCTM(404.51,SCTM,0)),U,5)'=1 S SCOK=0
|
|---|
| 56 | . Q
|
|---|
| 57 | ;bp/cmf 204 change code end
|
|---|
| 58 | S SCDT=$O(^SCPT(404.43,"APCPOS",DFN,ROLE,3990101),-1)
|
|---|
| 59 | S SCTPRL=$O(^SCPT(404.43,"APCPOS",DFN,ROLE,+SCDT,0))
|
|---|
| 60 | S SCPTTP=$O(^SCPT(404.43,"APCPOS",DFN,ROLE,+SCDT,+SCTPRL,0))
|
|---|
| 61 | ;check if active
|
|---|
| 62 | IF SCPTTP D
|
|---|
| 63 | .S SCNODE=$G(^SCPT(404.43,SCPTTP,0))
|
|---|
| 64 | .S SCACT=$P(SCNODE,U,3)
|
|---|
| 65 | .Q:(DATE=SCACT)&(SCTP=SCTPRL) ;if this date & position (editing current
|
|---|
| 66 | .S SCINACT=$P(SCNODE,U,4)
|
|---|
| 67 | .IF SCINACT D
|
|---|
| 68 | ..IF SCINACT>DATE D
|
|---|
| 69 | ...S SCOK=0 ;no making pc role before currently defined
|
|---|
| 70 | .ELSE D
|
|---|
| 71 | ..S SCOK=0 ;no making pc role without inactivating current
|
|---|
| 72 | QTCHKRL Q SCOK
|
|---|
