Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SCMCTPU2

SCMCTPU2.m

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