| [613] | 1 | SCMCQK ;ALB/REW - Single Pt Tm/Pt Tm Pos Assign and Discharge ; 1 Jul 1998
|
|---|
| 2 | ;;5.3;Scheduling;**148,177,297**;AUG 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | EN ; - main call
|
|---|
| 5 | W !,"Primary Care Team/PC Assignment/Unassignment",!
|
|---|
| 6 | W !,?6,"Prior to using this option, PCMM's Graphical User Interface (GUI)"
|
|---|
| 7 | W !,?6,"must be used to:"
|
|---|
| 8 | W !,?10,"1) Setup active primary care and non-primary care team(s)"
|
|---|
| 9 | W !,?10,"2) Setup active PC and non-primary care Practitioner position(s)"
|
|---|
| 10 | W !,?10,"3) Setup any necessary preceptor/preceptee relationships"
|
|---|
| 11 | W !,?10,"4) Assign practitioner to position(s)"
|
|---|
| 12 | W !!?6,"A patient can only have one PC team and one"
|
|---|
| 13 | W !?6,"PC Position assignment on a given day. The patient must be"
|
|---|
| 14 | W !?6,"assigned to a position's team to be assigned to the position."
|
|---|
| 15 | W !!?6,"Note: You must use the PCMM GUI if the patient was:"
|
|---|
| 16 | W !?10,"o unassigned from PC assignment today or in the future"
|
|---|
| 17 | W !?10,"o assigned to a future PC assignment."
|
|---|
| 18 | N DFN
|
|---|
| 19 | F S DFN=$$PATIENT() Q:DFN<0 D PAT
|
|---|
| 20 | Q
|
|---|
| 21 | ;
|
|---|
| 22 | PAT ;process patient
|
|---|
| 23 | Q:'$G(DFN)
|
|---|
| 24 | N SCTPSTAT,SCTMSTAT,SCSTAT,SCTM,SCTP
|
|---|
| 25 | W !,"Checking PC Team and Position Status...",!
|
|---|
| 26 | ;display PC info, check if patient has a current PC team
|
|---|
| 27 | D PCMM^SCRPU4(DFN,DT)
|
|---|
| 28 | D DSPL^SCMCQK2
|
|---|
| 29 | N DATA
|
|---|
| 30 | S DATA=$$IU^SCMCTSK1(DFN)
|
|---|
| 31 | I $E(DATA)=1 I $D(^XUSEC("SC PCMM SETUP",+$G(DUZ))) D
|
|---|
| 32 | .W !,"This patient was inactivated from "_$P(DATA,"~",2)_" TEAM"
|
|---|
| 33 | .W !,$P(DATA,"~",4)_" Position"
|
|---|
| 34 | .W !,"Do you wish to reactivate" S %=2 D YN^DICN
|
|---|
| 35 | .I %=1 D FILEIN^SCMCTSK3(.DATA,+$P(DATA,"~",6))
|
|---|
| 36 | W !,"Do you want to make a primary care assignment/unassignment" S %=1 D YN^DICN Q:%<0
|
|---|
| 37 | I %=2 G NPC^SCMCQK2
|
|---|
| 38 | ;below functions return status^message^pointer
|
|---|
| 39 | S SCTMSTAT=$$YSPTTMPC^SCMCTMU2(DFN,DT) ;ok to assign new PC team?
|
|---|
| 40 | S SCTPSTAT=$$YSPTTPPC^SCMCTPU2(DFN,DT,1) ;ok to assign new PC prac?
|
|---|
| 41 | ;what is current/future PC assignment status?
|
|---|
| 42 | S SCSTAT=$S((SCTMSTAT&SCTPSTAT):"NONE",('SCTMSTAT&SCTPSTAT):"TEAM",('SCTMSTAT&'SCTPSTAT):"BOTH",1:"ERROR") ;error if PC pract w/o PC team assignment
|
|---|
| 43 | W:SCSTAT="NONE" !,"No current PC Team/PC Practitioner Assignments"
|
|---|
| 44 | IF $S(SCTMSTAT:0,(SCTMSTAT["future"):1,1:0) W !,$P(SCTMSTAT,U,2) S SCSTAT="FUTURE"
|
|---|
| 45 | IF $S(SCTPSTAT:0,(SCTPSTAT["future"):1,1:0) W !,$P(SCTPSTAT,U,2) S SCSTAT="FUTURE"
|
|---|
| 46 | S SCTM=$P(SCTMSTAT,U,3)
|
|---|
| 47 | S SCTP=$P(SCTPSTAT,U,3)
|
|---|
| 48 | D @SCSTAT
|
|---|
| 49 | D BREAK
|
|---|
| 50 | Q
|
|---|
| 51 | ;
|
|---|
| 52 | BREAK ;
|
|---|
| 53 | N DIR,X,Y
|
|---|
| 54 | S DIR(0)="EA",DIR("A",1)="",DIR("A")="Press enter to continue."
|
|---|
| 55 | D ^DIR
|
|---|
| 56 | Q
|
|---|
| 57 | ;
|
|---|
| 58 | NONE ;
|
|---|
| 59 | N SCASSDT
|
|---|
| 60 | D ASTM^SCMCQK1
|
|---|
| 61 | Q
|
|---|
| 62 | TEAM ;
|
|---|
| 63 | N DIR,X,Y,SCDISCH,SCASSDT,SCSELECT
|
|---|
| 64 | S DIR(0)="SO^1:POSITION ASSIGNMENT - BY PRACTITIONER NAME;2:POSITION ASSIGNMENT - BY POSITION NAME;3:TEAM UNASSIGNMENT"
|
|---|
| 65 | D ^DIR
|
|---|
| 66 | IF $P(Y,U,1)=1!($P(Y,U,1)=2) D
|
|---|
| 67 | .S SCSELECT=$S($P(Y,U,1)=1:"PRACT",1:"POSIT")
|
|---|
| 68 | .D ASTP^SCMCQK1
|
|---|
| 69 | ELSE D:$P(Y,U,1)=3 UNTM^SCMCQK1
|
|---|
| 70 | Q
|
|---|
| 71 | ;
|
|---|
| 72 | BOTH ;
|
|---|
| 73 | N DIR,X,Y,SCDISCH
|
|---|
| 74 | S DIR(0)="SO^1:PC ASSIGNMENT UNASSIGNMENT;2:TEAM UNASSIGNMENT"
|
|---|
| 75 | D ^DIR
|
|---|
| 76 | IF $P(Y,U,1)=1 D
|
|---|
| 77 | .D UNTP^SCMCQK1
|
|---|
| 78 | ELSE D:$P(Y,U,1)=2 UNTM^SCMCQK1
|
|---|
| 79 | Q
|
|---|
| 80 | ;
|
|---|
| 81 | FUTURE ;
|
|---|
| 82 | W !,"This patient has future assignments for Primary Care"
|
|---|
| 83 | W !,"Team and/or Practitioner"
|
|---|
| 84 | W !!!,"You must use PCMM's Graphical User Interface to change"
|
|---|
| 85 | Q
|
|---|
| 86 | ;
|
|---|
| 87 | ERROR ;
|
|---|
| 88 | W !,"This patient has NO active Primary Care Team, but does have"
|
|---|
| 89 | W !,"an active PC Position Assignment"
|
|---|
| 90 | W !!!,"You must use PCMM's Graphical User Interface to correct"
|
|---|
| 91 | Q
|
|---|
| 92 | ;
|
|---|
| 93 | PATIENT() ;Return Patient DFN or -1
|
|---|
| 94 | ;
|
|---|
| 95 | N DIC,X,Y
|
|---|
| 96 | W !!!
|
|---|
| 97 | S DIC=2
|
|---|
| 98 | S DIC(0)="AEMQZ"
|
|---|
| 99 | D ^DIC
|
|---|
| 100 | Q $S($D(DTOUT):-1,$D(DUOUT):-1,(Y<0):-1,1:+Y)
|
|---|
