SCMCBK6.m

SCMCBK6 ;bp/cmf - multiple patient assignments mail queue - RPCVersion = 1 ;;Aug 7, 1998

 ;;5.3;Scheduling;**148,177,210,1015**;AUG 13, 1993;Build 21

 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;;

 ;;

SCMCBK6   ;bp/cmf - multiple patient assignments mail queue - RPCVersion = 1 ;;Aug 7, 1998

 +1       ;;5.3;Scheduling;**148,177,210,1015**;AUG 13, 1993;Build 21

 +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       ;;