SCMCBK6 ;bp/cmf - multiple patient assignments mail queue - RPCVersion = 1 ;;Aug 7, 1998
;;5.3;Scheduling;**148,177,210**;AUG 13, 1993
Q
;
YSPTTMPC(DFN,SCACT) ;is it ok to give patient a new pc team?
; Return [OK:1,Not OK: 0^Message]
N SCOK,SCX,SCTM
;
;does pt have a current pc team?
S SCTM=$$GETPCTM^SCAPMCU2(DFN,DT,1)
I SCTM>0 D SCOK(2) G QTOKPC
;;;IF SCTM>0 S SCOK="0^Pt has current PC Team Assignment"_U_SCTM G QTOKPC
;
;does pt have a future pc team?
S SCX=$O(^SCPT(404.42,"APCTM",DFN,1,SCACT))
IF SCX D SCOK(3) G QTOKPC
;;;.S SCTM=$O(^SCPT(404.42,"APCTM",DFN,1,+SCX,0))
;;;.S SCOK="0^Patient has future PC Assignment to the "_$P($G(^SCTM(404.51,+SCTM,0)),U,1)_" team."_U_SCTM
;;;.D SCOK(3)
;
S SCOK=1
QTOKPC Q SCOK
;
OKPTTMPC(DFN,SCTM,DATE) ; like OKPTTMPC^SCMCTMU2
; ;;; supports meaningful reject messages
; ;;; for PHASE II enhancement??
; Return [OK:1,Not OK: 0^Message]
N SCOK,SCPCTM,SCL
S SCOK=1
;
;is this a possible pc team?
;;;I '$P($G(^SCTM(404.51,+$G(SCTM),0)),U,5) S SCOK=0 G QTOKTM
I '$P($G(^SCTM(404.51,+$G(SCTM),0)),U,5) D SCOK(5) G QTOKTM
S SCPCTM=$$GETPCTM^SCAPMCU2(DFN,DATE,1)
I SCPCTM,SCPCTM'=SCTM D SCOK(7) G QTOKTM
;;;.I SCPCTM'=SCTM D
;;;..S SCOK=0
;;;;..D SCOK(7)
E D
.S SCOK=$$YSPTTMPC(DFN,DATE)
QTOKTM Q SCOK
;
DP(DFN) ;output: boolean, is patient(DFN) dead?
Q $P($G(^DPT(DFN,.35)),U)'=""
;
SCOK(SCL) ;
;input SCL = Text Line
;output = SCOK
S SCOK="0^"_$$S(SCL)_U_$G(SCTM)
Q
;
S(SCL) ;output: text string
Q $P($T(T+SCL),";;",2)
;
T ;;
1 ;;Pt is deceased;;
2 ;;Pt has current PC assignment;;
3 ;;Pt has future PC assignment;;
4 ;;Pt has future team assignment;;
5 ;;Not PC team;;
6 ;;Team inactive;;
7 ;;Pt has PC assignment;;
;;
9 ;;Invalid setup;;
10 ;;Pt already assigned;;
11 ;;Filer error;;
12 ;;PC role not assignable;;
13 ;;Invalid position list;;
14 ;;Pt not added to team;;
15 ;;Pt being assigned by another PCMM process;;
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMCBK6 2016 printed Nov 22, 2024@17:49:51 Page 2
SCMCBK6 ;bp/cmf - multiple patient assignments mail queue - RPCVersion = 1 ;;Aug 7, 1998
+1 ;;5.3;Scheduling;**148,177,210**;AUG 13, 1993
+2 QUIT
+3 ;
YSPTTMPC(DFN,SCACT) ;is it ok to give patient a new pc team?
+1 ; Return [OK:1,Not OK: 0^Message]
+2 NEW SCOK,SCX,SCTM
+3 ;
+4 ;does pt have a current pc team?
+5 SET SCTM=$$GETPCTM^SCAPMCU2(DFN,DT,1)
+6 IF SCTM>0
DO SCOK(2)
GOTO QTOKPC
+7 ;;;IF SCTM>0 S SCOK="0^Pt has current PC Team Assignment"_U_SCTM G QTOKPC
+8 ;
+9 ;does pt have a future pc team?
+10 SET SCX=$ORDER(^SCPT(404.42,"APCTM",DFN,1,SCACT))
+11 IF SCX
DO SCOK(3)
GOTO QTOKPC
+12 ;;;.S SCTM=$O(^SCPT(404.42,"APCTM",DFN,1,+SCX,0))
+13 ;;;.S SCOK="0^Patient has future PC Assignment to the "_$P($G(^SCTM(404.51,+SCTM,0)),U,1)_" team."_U_SCTM
+14 ;;;.D SCOK(3)
+15 ;
+16 SET SCOK=1
QTOKPC QUIT SCOK
+1 ;
OKPTTMPC(DFN,SCTM,DATE) ; like OKPTTMPC^SCMCTMU2
+1 ; ;;; supports meaningful reject messages
+2 ; ;;; for PHASE II enhancement??
+3 ; Return [OK:1,Not OK: 0^Message]
+4 NEW SCOK,SCPCTM,SCL
+5 SET SCOK=1
+6 ;
+7 ;is this a possible pc team?
+8 ;;;I '$P($G(^SCTM(404.51,+$G(SCTM),0)),U,5) S SCOK=0 G QTOKTM
+9 IF '$PIECE($GET(^SCTM(404.51,+$GET(SCTM),0)),U,5)
DO SCOK(5)
GOTO QTOKTM
+10 SET SCPCTM=$$GETPCTM^SCAPMCU2(DFN,DATE,1)
+11 IF SCPCTM
IF SCPCTM'=SCTM
DO SCOK(7)
GOTO QTOKTM
+12 ;;;.I SCPCTM'=SCTM D
+13 ;;;..S SCOK=0
+14 ;;;;..D SCOK(7)
+15 IF '$TEST
Begin DoDot:1
+16 SET SCOK=$$YSPTTMPC(DFN,DATE)
End DoDot:1
QTOKTM QUIT SCOK
+1 ;
DP(DFN) ;output: boolean, is patient(DFN) dead?
+1 QUIT $PIECE($GET(^DPT(DFN,.35)),U)'=""
+2 ;
SCOK(SCL) ;
+1 ;input SCL = Text Line
+2 ;output = SCOK
+3 SET SCOK="0^"_$$S(SCL)_U_$GET(SCTM)
+4 QUIT
+5 ;
S(SCL) ;output: text string
+1 QUIT $PIECE($TEXT(T+SCL),";;",2)
+2 ;
T ;;
1 ;;Pt is deceased;;
2 ;;Pt has current PC assignment;;
3 ;;Pt has future PC assignment;;
4 ;;Pt has future team assignment;;
5 ;;Not PC team;;
6 ;;Team inactive;;
7 ;;Pt has PC assignment;;
+1 ;;
9 ;;Invalid setup;;
10 ;;Pt already assigned;;
11 ;;Filer error;;
12 ;;PC role not assignable;;
13 ;;Invalid position list;;
14 ;;Pt not added to team;;
15 ;;Pt being assigned by another PCMM process;;
+1 ;;
