- SCMCTPU2 ;ALB/REW - Team Position Utilities ; 9 Jun 1995
- ;;5.3;Scheduling;**41,148,204,1015**;AUG 13, 1993;Build 21
- ;1
- YSPTTPPC(DFN,SCACT,SCROLE) ;is it ok to give patient a new pc position
- ;
- ; Return [OK:1,Not OK: 0^Message]
- Q:"2^1"'[$G(SCROLE) "0^Bad PC Role"
- N SCOK,SCX,SCTP,SCROLETX
- S SCROLETX=$S(SCROLE=1:"Practitioner",(SCROLE=2):"Attending",1:"Error")
- ;does pt have a current pc position?
- S SCTP=$$GETPCTP^SCAPMCU2(DFN,DT,SCROLE)
- IF SCTP>0 S SCOK="0^Pt has current PC "_SCROLETX_" Position Assignment"_U_SCTP G QTOKPC
- ;does pt have a future pc position?
- S SCX=$O(^SCPT(404.43,"APCPOS",DFN,SCROLE,SCACT))
- IF SCX D G QTOKPC
- .S SCTP=$O(^SCPT(404.43,"APCPOS",DFN,SCROLE,+SCX,0))
- .S SCOK="0^Patient has future PC Assignment to the "_$P($G(^SCTM(404.57,+SCTP,0)),U,1)_" position."_U_SCTP
- S SCOK=1
- QTOKPC Q SCOK
- ;
- OKACPTTP(DFN,SCTP,DATE,ACTIVE) ;is it ok to activate pt pos assignment?
- N SCOK,SCDT,SCNODE,SCINACT
- S SCOK=1
- G:'$D(^SCPT(404.43,"ADFN",DFN)) ENDOK ;quick check
- ;is position active now(if checking)?
- IF $G(ACTIVE) D G:'SCOK ENDOK
- . S SCOK=+$$ACTTP^SCMCTPU(SCTP,DATE)
- ;is the patient assigned to this position either now or in future?
- S SCDT=$O(^SCPT(404.43,"ADFN",DFN,SCTP,3990101),-1)
- S SCPTTP=$O(^SCPT(404.43,"ADFN",DFN,SCTP,+SCDT,0))
- IF SCPTTP D
- .S SCNODE=$G(^SCPT(404.43,SCPTTP,0))
- .S SCINACT=$P(SCNODE,U,4)
- .IF ('SCINACT)!(SCINACT>DATE) D
- ..S SCOK=0 ;no inactive date or inact after date
- ENDOK Q SCOK
- ;
- PCRLPTTP(DFN,SCTP,DATE) ; can position be pc practitioner or pc attending
- ; return yes pract^yes attend
- Q $$CHKROLE(DFN,SCTP,DATE,1)_U_$$CHKROLE(DFN,SCTP,DATE,2)
- ;
- CHKROLE(DFN,SCTP,DATE,ROLE) ;can position file role for patient?
- ;this is not a stand-alone function
- N SCCUR,SCDT,SCTPRL,SCPTTP,SCOK,SCNODE,SCINACT,SCACT
- S SCOK=1
- ;bp/cmf 204 change code begin
- ;original code next line
- ;IF $G(ROLE)&('$P($G(^SCTM(404.57,+$G(SCTP),0)),U,4)) S SCOK=0 G QTCHKRL
- ;bp/cmf 204 new code begin
- ;bp/cmf 204 new code end
- I $G(ROLE) D G:SCOK=0 QTCHKRL
- . I '$P($G(^SCTM(404.57,+$G(SCTP),0)),U,4) S SCOK=0 Q
- . N SCTM
- . S SCTM=$P($G(^SCTM(404.57,SCTP,0)),U,2)
- . I $P($G(^SCTM(404.51,SCTM,0)),U,5)'=1 S SCOK=0
- . Q
- ;bp/cmf 204 change code end
- S SCDT=$O(^SCPT(404.43,"APCPOS",DFN,ROLE,3990101),-1)
- S SCTPRL=$O(^SCPT(404.43,"APCPOS",DFN,ROLE,+SCDT,0))
- S SCPTTP=$O(^SCPT(404.43,"APCPOS",DFN,ROLE,+SCDT,+SCTPRL,0))
- ;check if active
- IF SCPTTP D
- .S SCNODE=$G(^SCPT(404.43,SCPTTP,0))
- .S SCACT=$P(SCNODE,U,3)
- .Q:(DATE=SCACT)&(SCTP=SCTPRL) ;if this date & position (editing current
- .S SCINACT=$P(SCNODE,U,4)
- .IF SCINACT D
- ..IF SCINACT>DATE D
- ...S SCOK=0 ;no making pc role before currently defined
- .ELSE D
- ..S SCOK=0 ;no making pc role without inactivating current
- QTCHKRL Q SCOK
- SCMCTPU2 ;ALB/REW - Team Position Utilities ; 9 Jun 1995
- +1 ;;5.3;Scheduling;**41,148,204,1015**;AUG 13, 1993;Build 21
- +2 ;1
- YSPTTPPC(DFN,SCACT,SCROLE) ;is it ok to give patient a new pc position
- +1 ;
- +2 ; Return [OK:1,Not OK: 0^Message]
- +3 IF "2^1"'[$GET(SCROLE)
- QUIT "0^Bad PC Role"
- +4 NEW SCOK,SCX,SCTP,SCROLETX
- +5 SET SCROLETX=$SELECT(SCROLE=1:"Practitioner",(SCROLE=2):"Attending",1:"Error")
- +6 ;does pt have a current pc position?
- +7 SET SCTP=$$GETPCTP^SCAPMCU2(DFN,DT,SCROLE)
- +8 IF SCTP>0
- SET SCOK="0^Pt has current PC "_SCROLETX_" Position Assignment"_U_SCTP
- GOTO QTOKPC
- +9 ;does pt have a future pc position?
- +10 SET SCX=$ORDER(^SCPT(404.43,"APCPOS",DFN,SCROLE,SCACT))
- +11 IF SCX
- Begin DoDot:1
- +12 SET SCTP=$ORDER(^SCPT(404.43,"APCPOS",DFN,SCROLE,+SCX,0))
- +13 SET SCOK="0^Patient has future PC Assignment to the "_$PIECE($GET(^SCTM(404.57,+SCTP,0)),U,1)_" position."_U_SCTP
- End DoDot:1
- GOTO QTOKPC
- +14 SET SCOK=1
- QTOKPC QUIT SCOK
- +1 ;
- OKACPTTP(DFN,SCTP,DATE,ACTIVE) ;is it ok to activate pt pos assignment?
- +1 NEW SCOK,SCDT,SCNODE,SCINACT
- +2 SET SCOK=1
- +3 ;quick check
- IF '$DATA(^SCPT(404.43,"ADFN",DFN))
- GOTO ENDOK
- +4 ;is position active now(if checking)?
- +5 IF $GET(ACTIVE)
- Begin DoDot:1
- +6 SET SCOK=+$$ACTTP^SCMCTPU(SCTP,DATE)
- End DoDot:1
- IF 'SCOK
- GOTO ENDOK
- +7 ;is the patient assigned to this position either now or in future?
- +8 SET SCDT=$ORDER(^SCPT(404.43,"ADFN",DFN,SCTP,3990101),-1)
- +9 SET SCPTTP=$ORDER(^SCPT(404.43,"ADFN",DFN,SCTP,+SCDT,0))
- +10 IF SCPTTP
- Begin DoDot:1
- +11 SET SCNODE=$GET(^SCPT(404.43,SCPTTP,0))
- +12 SET SCINACT=$PIECE(SCNODE,U,4)
- +13 IF ('SCINACT)!(SCINACT>DATE)
- Begin DoDot:2
- +14 ;no inactive date or inact after date
- SET SCOK=0
- End DoDot:2
- End DoDot:1
- ENDOK QUIT SCOK
- +1 ;
- PCRLPTTP(DFN,SCTP,DATE) ; can position be pc practitioner or pc attending
- +1 ; return yes pract^yes attend
- +2 QUIT $$CHKROLE(DFN,SCTP,DATE,1)_U_$$CHKROLE(DFN,SCTP,DATE,2)
- +3 ;
- CHKROLE(DFN,SCTP,DATE,ROLE) ;can position file role for patient?
- +1 ;this is not a stand-alone function
- +2 NEW SCCUR,SCDT,SCTPRL,SCPTTP,SCOK,SCNODE,SCINACT,SCACT
- +3 SET SCOK=1
- +4 ;bp/cmf 204 change code begin
- +5 ;original code next line
- +6 ;IF $G(ROLE)&('$P($G(^SCTM(404.57,+$G(SCTP),0)),U,4)) S SCOK=0 G QTCHKRL
- +7 ;bp/cmf 204 new code begin
- +8 ;bp/cmf 204 new code end
- +9 IF $GET(ROLE)
- Begin DoDot:1
- +10 IF '$PIECE($GET(^SCTM(404.57,+$GET(SCTP),0)),U,4)
- SET SCOK=0
- QUIT
- +11 NEW SCTM
- +12 SET SCTM=$PIECE($GET(^SCTM(404.57,SCTP,0)),U,2)
- +13 IF $PIECE($GET(^SCTM(404.51,SCTM,0)),U,5)'=1
- SET SCOK=0
- +14 QUIT
- End DoDot:1
- IF SCOK=0
- GOTO QTCHKRL
- +15 ;bp/cmf 204 change code end
- +16 SET SCDT=$ORDER(^SCPT(404.43,"APCPOS",DFN,ROLE,3990101),-1)
- +17 SET SCTPRL=$ORDER(^SCPT(404.43,"APCPOS",DFN,ROLE,+SCDT,0))
- +18 SET SCPTTP=$ORDER(^SCPT(404.43,"APCPOS",DFN,ROLE,+SCDT,+SCTPRL,0))
- +19 ;check if active
- +20 IF SCPTTP
- Begin DoDot:1
- +21 SET SCNODE=$GET(^SCPT(404.43,SCPTTP,0))
- +22 SET SCACT=$PIECE(SCNODE,U,3)
- +23 ;if this date & position (editing current
- IF (DATE=SCACT)&(SCTP=SCTPRL)
- QUIT
- +24 SET SCINACT=$PIECE(SCNODE,U,4)
- +25 IF SCINACT
- Begin DoDot:2
- +26 IF SCINACT>DATE
- Begin DoDot:3
- +27 ;no making pc role before currently defined
- SET SCOK=0
- End DoDot:3
- End DoDot:2
- +28 IF '$TEST
- Begin DoDot:2
- +29 ;no making pc role without inactivating current
- SET SCOK=0
- End DoDot:2
- End DoDot:1
- QTCHKRL QUIT SCOK
