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