source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCMCBK6.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.9 KB
Line 
1SCMCBK6 ;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 ;
5YSPTTMPC(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
22QTOKPC Q SCOK
23 ;
24OKPTTMPC(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)
41QTOKTM Q SCOK
42 ;
43DP(DFN) ;output: boolean, is patient(DFN) dead?
44 Q $P($G(^DPT(DFN,.35)),U)'=""
45 ;
46SCOK(SCL) ;
47 ;input SCL = Text Line
48 ;output = SCOK
49 S SCOK="0^"_$$S(SCL)_U_$G(SCTM)
50 Q
51 ;
52S(SCL) ;output: text string
53 Q $P($T(T+SCL),";;",2)
54 ;
55T ;;
561 ;;Pt is deceased;;
572 ;;Pt has current PC assignment;;
583 ;;Pt has future PC assignment;;
594 ;;Pt has future team assignment;;
605 ;;Not PC team;;
616 ;;Team inactive;;
627 ;;Pt has PC assignment;;
63 ;;
649 ;;Invalid setup;;
6510 ;;Pt already assigned;;
6611 ;;Filer error;;
6712 ;;PC role not assignable;;
6813 ;;Invalid position list;;
6914 ;;Pt not added to team;;
7015 ;;Pt being assigned by another PCMM process;;
71 ;;
Note: See TracBrowser for help on using the repository browser.