source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCMCMU11.m@ 931

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

initial load of WorldVistAEHR
File size: 3.3 KB
Line 
1SCMCMU11 ;ALB/MJK - PCMM Mass Team/Position Unassignment ; 10-JUL-1998
2 ;;5.3;Scheduling;**148**;AUG 13, 1993
3 ;
4 ;
5PTTPLST(SCTEAM,SCDATE,SCPTTP) ; -- create list of patients assigned to team positions
6 ; -- sort list by dfn and position ien
7 N SCPOS,SCDTE,SCPR,SCPRX
8 ;
9 ; -- check for patient-position assignments
10 D DATE^SCMCMU1(SCDATE,.SCDTE)
11 S SCPOS=$NA(^TMP("SCMU",$J,"POSITION"))
12 ;
13 ; -- get list of positions for team
14 K @SCPOS
15 IF '$$TPTM^SCAPMC24(SCTEAM,SCDTE,"","",SCPOS) S Y=-1 G PTTPLSTQ
16 S SCPR=0
17 F S SCPR=$O(@SCPOS@(SCPR)) Q:'SCPR D
18 . S SCPRX=@SCPOS@(SCPR)
19 . ; -- create sorted list of dfn by position ien
20 . D PTTP(+SCPRX,SCDATE,SCPTTP)
21 . Q
22PTTPLSTQ K @SCPOS
23 Q
24 ;
25PTTP(SCPOS,SCDATE,SCPTTP) ; -- create list of pats assigned to position sort by dfn, position
26 N SCPAT,SCPATX,SCPATS,SCDTE
27 D DATE^SCMCMU1(SCDATE,.SCDTE)
28 S SCPATS=$NA(^TMP("SCMU",$J,"PATIENT"))
29 K @SCPATS
30 IF '$$PTTP^SCAPMC(SCPOS,SCDTE,SCPATS) S SCOK=0 G PTTPQ
31 S SCPAT=0
32 F S SCPAT=$O(@SCPATS@(SCPAT)) Q:'SCPAT D
33 . S SCPATX=@SCPATS@(SCPAT)
34 . ; -- store by dfn / pos data
35 . S @SCPTTP@(+SCPATX,SCPOS)=SCPATX
36 . Q
37PTTPQ K @SCPATS
38 Q
39 ;
40UNASSIGN ; -- unassign selected
41 ; protocol: SCMC MU UNASSIGN PATIENTS
42 N DIR,Y
43 IF 'SCSELCNT D G UNQ
44 . W !!,"No patients have been selected.",!
45 . D PAUSE^SCMCMU1
46 . D BACK^SCMCMU1("")
47 . Q
48 ELSE D
49 . D FULL^VALM1
50 . W @IOF
51 . S DIR(0)="YA"
52 . D SET("----------------------------------------------------------------------------")
53 . D SET(" Team"_$S(SCMUTYPE="P":" Position",1:"")_" Unassignment Definition")
54 . D SET("----------------------------------------------------------------------------")
55 . D SET(" Team : "_$P($G(^SCTM(404.51,SCTEAM,0),"Unknown"),U))
56 . IF SCMUTYPE="P" D SET(" Position : "_$P($G(^SCTM(404.57,SCPOS,0),"Unknown"),U))
57 . D SET(" Effective Date : "_$$FMTE^XLFDT($E(SCDATE,1,7),"5Z"))
58 . D SET(" # of Patients : "_SCSELCNT)
59 . D CLINIC
60 . D SET(" ")
61 . S DIR("A")="Are you sure you want to continue? "
62 . S DIR("B")="No"
63 . D ^DIR
64 . IF Y=1 D
65 . . N DIR,SCTSK
66 . . S SCTSK=$$QUE^SCMCMU2()
67 . . IF SCTSK="" D
68 . . . D BACK^SCMCMU1("R")
69 . . ELSE D
70 . . . W !!,"Task#: ",SCTSK,!
71 . . D PAUSE^SCMCMU1
72 . . Q
73 . ELSE D
74 . . D BACK^SCMCMU1("R")
75 . . Q
76 . Q
77UNQ Q
78 ;
79CLINIC ; -- display clinic to be discharged from
80 N SCPOS,SCX,Y
81 D SET(" ")
82 IF '$O(SCTPDIS(0)) D G CLINICQ
83 . D SET(" Clinic Discharges: None")
84 ;
85 S Y=""
86 S Y=$$SETSTR^VALM1("Clinic Discharges:",Y,5,20)
87 S Y=$$SETSTR^VALM1("Position",Y,25,25)
88 S Y=$$SETSTR^VALM1("Associated Clinic",Y,55,25)
89 D SET(Y)
90 S Y=""
91 S Y=$$SETSTR^VALM1("--------",Y,25,25)
92 S Y=$$SETSTR^VALM1("-----------------",Y,55,25)
93 D SET(Y)
94 ;
95 S SCPOS=0
96 F S SCPOS=$O(SCTPDIS(SCPOS)) Q:'SCPOS D
97 . S SCX=$G(^SCTM(404.57,SCPOS,0),"Unknown")
98 . S Y=""
99 . S Y=$$SETSTR^VALM1($E($P(SCX,U),1,25),Y,25,25)
100 . S Y=$$SETSTR^VALM1($E($P($G(^SC(+$P(SCX,U,9),0),"Unknown"),U),1,25),Y,55,25)
101 . D SET(Y)
102 . Q
103 ;
104CLINICQ Q
105 ;
106SET(X) ; -- set DIR text
107 S DIR("A",$O(DIR("A",""),-1)+1)=X
108 Q
109 ;
110QUIT ; -- quit logic
111 ; protocol: SCMC MU QUIT
112 N DIR,Y
113 S Y=0
114 IF SCSELCNT D
115 . W !
116 . S DIR(0)="YA"
117 . S DIR("A",1)="You have "_SCSELCNT_" patient"_$S(SCSELCNT=1:"",1:"s")_" selected."
118 . S DIR("A",2)=" "
119 . S DIR("A")="Are you sure you want to quit? "
120 . S DIR("B")="No"
121 . D ^DIR
122 . IF Y'=1 D BACK^SCMCMU1("")
123 . Q
124 Q
125 ;
Note: See TracBrowser for help on using the repository browser.