1 | SCMCBK6 ;bp/cmf - multiple patient assignments mail queue - RPCVersion = 1 ;;Aug 7, 1998
|
---|
2 | ;;5.3;Scheduling;**148,177,210**;AUG 13, 1993
|
---|
3 | Q
|
---|
4 | ;
|
---|
5 | YSPTTMPC(DFN,SCACT) ;is it ok to give patient a new pc team?
|
---|
6 | ; Return [OK:1,Not OK: 0^Message]
|
---|
7 | N SCOK,SCX,SCTM
|
---|
8 | ;
|
---|
9 | ;does pt have a current pc team?
|
---|
10 | S SCTM=$$GETPCTM^SCAPMCU2(DFN,DT,1)
|
---|
11 | I SCTM>0 D SCOK(2) G QTOKPC
|
---|
12 | ;;;IF SCTM>0 S SCOK="0^Pt has current PC Team Assignment"_U_SCTM G QTOKPC
|
---|
13 | ;
|
---|
14 | ;does pt have a future pc team?
|
---|
15 | S SCX=$O(^SCPT(404.42,"APCTM",DFN,1,SCACT))
|
---|
16 | IF SCX D SCOK(3) G QTOKPC
|
---|
17 | ;;;.S SCTM=$O(^SCPT(404.42,"APCTM",DFN,1,+SCX,0))
|
---|
18 | ;;;.S SCOK="0^Patient has future PC Assignment to the "_$P($G(^SCTM(404.51,+SCTM,0)),U,1)_" team."_U_SCTM
|
---|
19 | ;;;.D SCOK(3)
|
---|
20 | ;
|
---|
21 | S SCOK=1
|
---|
22 | QTOKPC Q SCOK
|
---|
23 | ;
|
---|
24 | OKPTTMPC(DFN,SCTM,DATE) ; like OKPTTMPC^SCMCTMU2
|
---|
25 | ; ;;; supports meaningful reject messages
|
---|
26 | ; ;;; for PHASE II enhancement??
|
---|
27 | ; Return [OK:1,Not OK: 0^Message]
|
---|
28 | N SCOK,SCPCTM,SCL
|
---|
29 | S SCOK=1
|
---|
30 | ;
|
---|
31 | ;is this a possible pc team?
|
---|
32 | ;;;I '$P($G(^SCTM(404.51,+$G(SCTM),0)),U,5) S SCOK=0 G QTOKTM
|
---|
33 | I '$P($G(^SCTM(404.51,+$G(SCTM),0)),U,5) D SCOK(5) G QTOKTM
|
---|
34 | S SCPCTM=$$GETPCTM^SCAPMCU2(DFN,DATE,1)
|
---|
35 | I SCPCTM,SCPCTM'=SCTM D SCOK(7) G QTOKTM
|
---|
36 | ;;;.I SCPCTM'=SCTM D
|
---|
37 | ;;;..S SCOK=0
|
---|
38 | ;;;;..D SCOK(7)
|
---|
39 | E D
|
---|
40 | .S SCOK=$$YSPTTMPC(DFN,DATE)
|
---|
41 | QTOKTM Q SCOK
|
---|
42 | ;
|
---|
43 | DP(DFN) ;output: boolean, is patient(DFN) dead?
|
---|
44 | Q $P($G(^DPT(DFN,.35)),U)'=""
|
---|
45 | ;
|
---|
46 | SCOK(SCL) ;
|
---|
47 | ;input SCL = Text Line
|
---|
48 | ;output = SCOK
|
---|
49 | S SCOK="0^"_$$S(SCL)_U_$G(SCTM)
|
---|
50 | Q
|
---|
51 | ;
|
---|
52 | S(SCL) ;output: text string
|
---|
53 | Q $P($T(T+SCL),";;",2)
|
---|
54 | ;
|
---|
55 | T ;;
|
---|
56 | 1 ;;Pt is deceased;;
|
---|
57 | 2 ;;Pt has current PC assignment;;
|
---|
58 | 3 ;;Pt has future PC assignment;;
|
---|
59 | 4 ;;Pt has future team assignment;;
|
---|
60 | 5 ;;Not PC team;;
|
---|
61 | 6 ;;Team inactive;;
|
---|
62 | 7 ;;Pt has PC assignment;;
|
---|
63 | ;;
|
---|
64 | 9 ;;Invalid setup;;
|
---|
65 | 10 ;;Pt already assigned;;
|
---|
66 | 11 ;;Filer error;;
|
---|
67 | 12 ;;PC role not assignable;;
|
---|
68 | 13 ;;Invalid position list;;
|
---|
69 | 14 ;;Pt not added to team;;
|
---|
70 | 15 ;;Pt being assigned by another PCMM process;;
|
---|
71 | ;;
|
---|