source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORLP3U2.m@ 1311

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

initial load of WorldVistAEHR

File size: 7.3 KB
Line 
1ORLP3U2 ; SLC/PKS - Team List routines. [3/27/00 4:01pm]
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**63**;Dec 17, 1997
3 ;
4 Q
5 ;
6DEL ; Called by option: ORLP3M DELETE USER TEAMS.
7 ; Allows CAC menu deletion of personal Team Lists.
8 ;
9 ; Variables used:
10 ;
11 ; DIC = Fileman lookup routine.
12 ; DIK = Fileman deletion routine.
13 ; ORPTEAM = Personal Team to delete.
14 ; ORQUIT = Flag for quitting input loop.
15 ; ORUSER = Temporary user IEN holder.
16 ; ORHEAD = Flag for user list heading.
17 ; ORNAME = User name holder.
18 ; ORNODEL = Flag for no confirmation of deletion.
19 ;
20 N ORPQUIT,ORPTEAM,ORQUIT,ORUSER,ORHEAD,ORNAME,ORNODEL
21 ;
22 ; Set up loop to control action:
23 S ORPQUIT=1
24 F D Q:'ORPQUIT
25 .K DIC,DIK
26 .S DIC="^OR(100.21,"
27 .S DIC(0)="AEQM"
28 .S DIC("S")="I $P(^OR(100.21,+Y,0),U,2)=""P"""
29 .S DIC("A")="Select Personal Patient List to delete: "
30 .W !
31 .D ^DIC
32 .K DIC
33 .I Y<1 S ORPQUIT=0 Q ; Punt if no selection made.
34 .S ORPTEAM=Y
35 .;
36 .; Display any users currently on team:
37 .S ORHEAD=1 ; Set flag for heading.
38 .S ORUSER=0
39 .F S ORUSER=$O(^OR(100.21,+ORPTEAM,1,ORUSER)) Q:+ORUSER=0 D
40 ..I ORHEAD D ; First time through, print heading.
41 ...S ORHEAD=0 ; Reset flag.
42 ...W !!," Users currently on team ",$P(ORPTEAM,U,2),":",! ; Display heading.
43 ..S ORNAME=$P($G(^VA(200,ORUSER,0)),U) ; Get user's name.
44 ..W !," ",ORNAME
45 .I 'ORHEAD W !
46 .;
47 .; Get confirmation before deleting the Team List:
48 .S ORNODEL=0 ; Preset flag.
49 .S ORQUIT=0
50 .F Q:ORQUIT=1 D ; Loop to control user entry.
51 ..S %=1
52 ..W !,"Are you ready to delete list "_$PIECE(ORPTEAM,U,2)
53 ..D YN^DICN ; Fileman call for user input.
54 ..I %=2 S (ORNODEL,ORQUIT)=1 Q ; Set flags if user enters "NO."
55 ..I %=1 S ORQUIT=1 Q ; "YES" confirmation.
56 ..W !,"Enter YES to delete the list, NO to quit." ; For inappropriate entries, loop will repeat.
57 .I ORNODEL=1 Q ; Delete not confirmed.
58 .W !,"Working..." ; Keep user informed.
59 .L +^OR(100.21,+ORPTEAM):3 ; Handle file locking.
60 .S DIK="^OR(100.21,"
61 .S DA=+ORPTEAM
62 .D ^DIK ; Delete the Team List.
63 .K DIC,DIK,DA,Y,%
64 .L -^OR(100.21,+ORPTEAM) ; Unlock the file.
65 .W !,"Searching for/removing Consults pointers to deleted team..."
66 .D CLNLIST^GMRCTU(+ORPTEAM,0) ; Dump team pointers in file 123.5.
67 .; Leave success message:
68 .W !,"List deletion completed."
69 ;
70 Q
71 ;
72AR ; Called by option: ORLP3U ON/OFF A/L TEAMS.
73 ; Allows users to add/remove themselves from Autolinked Team Lists.
74 ; (Thanks to Rebecca Bates, Dayton VAMC, for head start on this.)
75 ;
76 ; Variables used:
77 ;
78 ; DIR = Fileman user input routine.
79 ; DIC = Fileman lookup routine.
80 ; DIE = Fileman edit routine.
81 ; DIK = Fileman deletion routine.
82 ; ORTEAM = Holder for team IEN.
83 ; ORNAME = Holder for team name.
84 ; ORCNT = Counter variable.
85 ; ORNONE = Flag; if true there are no current team assignments.
86 ; ORACT = User input holder.
87 ; ORRESULT = Result of file locking call.
88 ;
89 ; Set up outer control loop for this option's menu function:
90 N ORACT
91 S ORACT=0
92 F Q:ORACT=3 D ; Overall control loop.
93 .;
94 .N DIR,DIC,DIE,DIK,ORTEAM,ORNAME,ORNONE,ORRESULT
95 .W ! ; Leave a blank line on the screen for clarity.
96 .S ORNONE=1
97 .I $D(^OR(100.21,"C",DUZ)) S ORNONE=0 D ; Current team assignments display control loop.
98 ..;
99 ..; Get list of currently-assigned Teams:
100 ..S ORTEAM="" ; Initialize.
101 ..F S ORTEAM=$O(^OR(100.21,"C",DUZ,ORTEAM)) Q:ORTEAM="" D ; Each Team where user is asociated.
102 ...;
103 ...; Next two lines of executable code create ^TMP entries as:
104 ...; ^TMP("ORLPAR",$J,228)="TEAM ABC"
105 ...; where 228 is a Team List IEN and "TEAM ABC" is a Team name,
106 ...; and the Team is an autolink type and subscribable (i.e.,
107 ...; the SUBSCRIBE field has a "Y" entry in it):
108 ...I $P(^OR(100.21,ORTEAM,0),"^",2)["A",$P($G(^OR(100.21,ORTEAM,0)),"^",6)="Y" S ^TMP("ORLPAR",$J,ORTEAM)=$P(^OR(100.21,ORTEAM,0),"^")
109 ..;
110 ..; If still no valid data, reset ORNONE and punt:
111 ..I '$D(^TMP("ORLPAR",$J)) S ORNONE=1 Q
112 ..;
113 ..; Display currently-associated Teams:
114 ..W !,"You are associated with the following autolinked teams:",!
115 ..S ORTEAM="" ; Initialize.
116 ..F S ORTEAM=$O(^TMP("ORLPAR",$J,ORTEAM)) Q:ORTEAM="" D ; Each team name.
117 ...S ORNAME=^TMP("ORLPAR",$J,ORTEAM) ; Assign name variable.
118 ...W !," "_ORNAME ; Print to screen.
119 .;
120 .; If no current associations, indicate same:
121 .I ORNONE W !,"You are not currently assigned to any teams."
122 .W ! ; Whether current assignments or not, leave a blank line for clarity.
123 .;
124 .; Set up call to DIR and get user input:
125 .S DIR("A")="Next action"
126 .S DIR("B")="Quit"
127 .S DIR("0")="SET^1:Add;2:Delete;3:Quit"
128 .S DIR("?")="Enter 1, 2, or 3: "
129 .I ORNONE D ; Change menu choices if deletions not appropriate.
130 ..S DIR("0")="S^1:Add;3:Quit"
131 ..S DIR("?")="Enter either 1 or 3: "
132 .D ^DIR
133 .K DIR
134 .I Y<0!$D(DIRUT)!$D(DTOUT)!$D(DUOUT) S ORACT=3 Q ; Quit on errors.
135 .I (+Y'=1)&(+Y'=2)&(+Y'=3) S ORACT=3 Q ; Quit if no acceptable response.
136 .S ORACT=+Y ; Assign user's response.
137 .I ORACT=3 Q ; Quit if user doesn't want any changes.
138 .;
139 .; Process deletions:
140 .I ORACT=2 D ; Deletion control loop.
141 ..;
142 ..; Get user input on Team List for removal:
143 ..S DIC(0)="AEMQZ"
144 ..S DIC="^OR(100.21,"
145 ..S DIC("S")="I $D(^TMP(""ORLPAR"",$J,+Y))"
146 ..S DIC("A")="Autolinked team for removal of yourself as user/provider: "
147 ..D ^DIC
148 ..I $D(DTOUT)!$D(DUOUT) Q ; Entry error.
149 ..I +Y<1 Q ; No selection made or bad selection.
150 ..S ORTEAM=+Y ; Assign team IEN variable.
151 ..S ORNAME=Y(0,0) ; Assign team name variable.
152 ..K DIC
153 ..;
154 ..; Remove the user from the list:
155 ..S ORRESULT=$$ARLOCK
156 ..I 'ORRESULT Q ; Quit if there's a locking problem.
157 ..S DA=DUZ
158 ..S DA(1)=ORTEAM
159 ..S DIK="^OR(100.21,"_DA(1)_","_1_","
160 ..D ^DIK
161 ..K DIK
162 ..L -^OR(100.21,ORTEAM) ; Clean up file lock.
163 ..Q
164 .;
165 .; Process additions:
166 .I ORACT=1 D ; Addition control loop.
167 ..;
168 ..; Get user input on Team List for addition:
169 ..S DIC="^OR(100.21,"
170 ..S DIC(0)="AEMQZ"
171 ..S DIC("S")="I $P(^OR(100.21,+Y,0),""^"",2)[""A"",$P($G(^OR(100.21,+Y,0)),""^"",6)=""Y"",'$D(^TMP(""ORLPAR"",$J,+Y))"
172 ..S DIC("A")="Autolinked team for addition of yourself as user/provider: "
173 ..D ^DIC
174 ..K DIC
175 ..I $D(DTOUT)!$D(DUOUT) Q ; Entry error.
176 ..I Y<1 Q ; No selection made or bad selection.
177 ..S ORTEAM=+Y ; Assign Team IEN variable.
178 ..;
179 ..; Add user to selected Team List:
180 ..S ORRESULT=$$ARLOCK
181 ..I 'ORRESULT Q ; Quit if there's a locking problem.
182 ..K Y,X
183 ..S DIC("P")=$P(^DD(100.21,2,0),"^",2)
184 ..S DIC(0)="LM"
185 ..S DA=DUZ
186 ..S DA(1)=ORTEAM
187 ..S DLAYGO=100.212
188 ..S X=$P($G(^VA(200,DUZ,0)),"^",1)
189 ..S DIC="^OR(100.21,"_DA(1)_",1,"
190 ..D ^DIC
191 ..K DIC,DLAYGO
192 ..L -^OR(100.21,ORTEAM) ; Clean up file lock.
193 ..Q
194 .;
195 .K ^TMP("ORLPAR",$J) ; Cleanup each time through.
196 ;
197 K ^TMP("ORLPAR",$J) ; Cleanup at end to be sure.
198 K DIRUT,DTOUT,DUOUT ; Cleanup error variables.
199 Q
200 ;
201ARLOCK(ORTEST) ; Handle locking of select Team List before editing.
202 ;
203 ; Variable used:
204 ;
205 ; ORTEST = Result of locking call.
206 ;
207 L +^OR(100.21,ORTEAM):5
208 S ORTEST=$TEST
209 I 'ORTEST W !,"Another user is editing this team.",!
210 Q ORTEST
211 ;
Note: See TracBrowser for help on using the repository browser.