- 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 Feb 19, 2025@00:06:21 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 ;;