source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCMCQK.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.3 KB
Line 
1SCMCQK ;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 ;
4EN ; - 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 ;
22PAT ;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 ;
52BREAK ;
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 ;
58NONE ;
59 N SCASSDT
60 D ASTM^SCMCQK1
61 Q
62TEAM ;
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 ;
72BOTH ;
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 ;
81FUTURE ;
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 ;
87ERROR ;
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 ;
93PATIENT() ;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)
Note: See TracBrowser for help on using the repository browser.