source: FOIAVistA/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCTU.m@ 1589

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

initial load of FOIAVistA 6/30/08 version
File size: 8.4 KB
Line 
1GMRCTU ; SLC-SLC/PKS Consults - Terminated users/remove pointers. ; [2/8/00 11:15am]
2 ;;3.0;CONSULT/REQUEST TRACKING;**9**;Dec 27, 1997
3 ;
4 ; OE/RR V3.0 - CONSULTS V3.0
5 ;
6 ; CONSULTS - Removes pointers upon termination.
7 ; The records to be edited are pointers to file #200, NEW PERSON.
8 ;
9 ; ------------------------------------------------------------------
10 ; Enter new files/fields at end of routine under entry label "TEXT."
11 ; ------------------------------------------------------------------
12 ;
13 ; Triggered by Kernel's XU USER TERMINATE event.
14 ; Applicable piece set to null or multiples delted.
15 ; Variable "USER" is DUZ of user for whom pointers will be removed.
16 ; The "USER" value must be passed to the routine by Kernel.
17 ;
18 ; Variables used:
19 ; NPARY = DB array with info on file/field.
20 ; CNT = Overall counter variable.
21 ; INFO = TEXT list variable.
22 ; VALUE = Value match string.
23 ; DIE,DA,DR,X = Used by calls to ^DIE.
24 ; NODE = Node to edit, if applicable.
25 ; PIECE = Piece of node to edit.
26 ; RSTR = Global root file string.
27 ; SSTR = Subfile string.
28 ; FILENUM = File number.
29 ; IEN = IEN string.
30 ; SIEN = Subfile IEN string.
31 ; FIELDNUM = Data Dictionary field number.
32 ; APPSTR = Append string variable.
33 ;
34 Q
35 ;
36EN ; Entry point - called by option: CONSULT TERMINATE CLEANUP.
37 ;
38 S USER=$GET(XUIFN) ; Assign user variable.
39 I USER="" Q ; If there's a problem, dump out right now.
40 D START(USER) ; Call the Control sequence for whole routine.
41 Q
42 ;
43FINDVAL ; See if VALUE (desired USER) exists in the record.
44 ;
45 S VALUE="" ; Initialize.
46 ;
47 I SSTR="" D Q ; If no subfile, quit after this IF.
48 .I $P($G(@(RSTR_+IEN_","_NODE_APPSTR)),"^",PIECE)=USER S VALUE=USER
49 ;
50 ; Process subfiles:
51 I $P($G(@(RSTR_+IEN_","_SSTR_","_SIEN_","_NODE_APPSTR)),"^",PIECE)=USER S VALUE=USER
52 ;
53 Q
54 ;
55CALLDIE ; Set FM variables and call DIE.
56 ;
57 N DIE,DA,DR,X
58 ;
59 I SSTR="" D Q ; No subfile involved.
60 .S DA=IEN,DIE=RSTR,DR=FIELDNUM_"///^S X=""@"""
61 .LOCK +@(DIE_IEN_")"):0
62 .D ^DIE ; User terminated, so call regardless of lock success.
63 .LOCK -@(DIE_IEN_")")
64 ;
65 ; Process subfile:
66 S DA(1)=IEN,DA=SIEN,DIE=RSTR_DA(1)_","_SSTR_",",DR=FIELDNUM_"///^S X=""@"""
67 LOCK +@(DIE_IEN_")"):0
68 D ^DIE ; User terminated, so call regardless of lock success.
69 LOCK -@(DIE_IEN_")")
70 ;
71 Q
72 ;
73MAIN ; Outer FOR loop to scan file for IENs, deleting pointer entries.
74 ;
75 D INFO^GMRCTU1(FILENUM,FIELDNUM,.NPARY) ; DB call, gets information.
76 ;
77 I (NPARY("DIC",0)="")!(NPARY("LOC")="") Q ; Problems? Dump out.
78 ;
79 ; Assign variables from resulting call:
80 S (RSTR,SSTR,NODE,PIECE,APPSTR)="" ; Initialize.
81 S RSTR=NPARY("DIC",1) ; Assign global root string.
82 ;
83 ; If a multiple, set flag and assign subfile string:
84 I $L($G(NPARY("DIC",2))) S SSTR=$P(NPARY("DIC",2),",",3)
85 S NODE=$P(NPARY("LOC"),";",1) ; Assign node variable.
86 S PIECE=$P(NPARY("LOC"),";",2) ; Assign piece variable.
87 S APPSTR=")" ; Assign append string.
88 ;
89 ; Order through file root entries:
90 S IEN="" ; Initialize.
91 ;
92 F S IEN=$O(@(RSTR_+IEN_")")) Q:+IEN=0 D
93 .I SSTR="" D Q ; Is subfile involved?
94 ..D FINDVAL ; Check for value match.
95 ..I VALUE=USER D CALLDIE ; If a match, clean out pointer entry.
96 .;
97 .; Process subfile multiples:
98 .S SIEN=0 ; Initialize.
99 .;
100 .F S SIEN=$O(@(RSTR_+IEN_","_SSTR_","_SIEN_")")) Q:+SIEN=0 D
101 ..D FINDVAL ; Check for value match.
102 ..I VALUE=USER D CALLDIE ; If a match, clean out pointer entry.
103 ;
104 Q
105 ;
106START(USER) ;Control sequence for complete process.
107 ;
108 N CNT,INFO
109 S CNT=4 ; Set CNT to first TEXT entry.
110 ;
111 ; Overall loop to get data from TEXT entries (at end of routine):
112 F D Q:INFO="QUIT"
113 .N NPARY,VALUE,DIE,DA,DR,X,NODE,PIECE,RSTR,SSTR,FILENUM,IEN,SIEN,FIELDNUM,APPSTR
114 .S CNT=CNT+1 ; Increment for each TEXT entry.
115 .S INFO=$P($TEXT(TEXT+CNT),";;",2) ; Get TEXT string.
116 .Q:INFO="QUIT" ; Finished when no more valid entries are found.
117 .;
118 .; Assign two variables from INFO string for each file/field:
119 .S FILENUM=$P(INFO,",",1)
120 .S FIELDNUM=$P(INFO,",",2)
121 .;
122 .D MAIN ; Proceed to main processing for each file/field.
123 ;
124 Q
125 ;
126 ; *******************************************************************
127 ;
128 ; Informational comments on files/fields added to TEXT section.
129 ;
130 ; File Name File#,Field Field Name
131 ; ------------------------------------------------------------------
132 ; REQUEST SERVICES 123.5,123.5 SPECIAL UPDATES INDIVIDUAL
133 ; REQUEST SERVICES 123.5,123.08 SERVICE INDIVIDUAL TO NOTIFY
134 ; (NOTIF. BY PT. LOC) 123.54,1 INDIVIDUAL TO NOTIFY
135 ; (UPD. USERS W/O NOT.) 123.55,.01 UPDATE USERS W/O NOTIFICATION
136 ; (ADM. UPDATE USERS) 123.555,.01 ADMINISTRATIVE UPDATE USER
137 ;
138 ; ===================================================================
139 ;
140 ; EXAMPLES of files/pointer entries being removed for above list:
141 ; (Where "777" is the USER) -
142 ;
143 ; ^GMR(123.5,2,0) = MEDICINE^1^^18^777
144 ; ^GMR(123.5,2,123) = 30^1795^2112^^^^^777^11^2199^^
145 ; ^GMR(123.5,2,123.2,2,0) = 1;DIC(42,^777^138
146 ; ^GMR(123.5,2,123.3,7,0) = 777 (<--Multiple)
147 ; ^GMR(123.5,2,123.33,2,0) = 777 (<--Multiple)
148 ;
149 ; *******************************************************************
150 ;
151TEXT ; Make entries below for new files/fields for pointer removal.
152 ; DO NOT remove or change the last line.
153 ; Enter comma-delimited lists using DD "pointers in" format:
154 ; Filenumber,Fieldnumber,EntryPersonLocation/Initials
155 ;
156 ;;123.5,123.5,ISC-SLC/PKS
157 ;;123.5,123.08,ISC-SLC/PKS
158 ;;123.54,1,ISC-SLC/PKS
159 ;;123.55,.01,ISC-SLC/PKS
160 ;;123.555,.01,ISC-SLC/PKS
161 ;;QUIT
162 Q
163 ;
164CLNLIST(ORLTEAM,ORLTASK) ; Clean out pointers to 100.21 from 123.5 when a Team List is deleted.
165 ;
166 ; Called by MAIN^ORLPTU (which deletes Personal Team Lists upon
167 ; termination of a sole or last user of the list).
168 ;
169 ; Called by DEL^ORLP1 (when a non-Personal Team List is deleted).
170 ;
171 ; Called by DEL^ORLP3U2 (when a Personal Team List is deleted
172 ; by menu action.
173 ;
174 ; The following pointers from 123.5 are processed here:
175 ;
176 ; Subfile Name File#,Field Field Name
177 ; ----------------------------------------------------------------
178 ; (SERVICE TEAM(S) TO NOTIFY) 123.1,.01 SERVICE TEAM TO NOTIFY
179 ; (NOTIF. BY PT LOCATION) 123.2,2 TEAM TO NOTIFY
180 ; (UPD. TEAMS W/O NOT.) 123.31,.01 UPDATE TEAMS W/O NOTIF.
181 ; (ADM. UPDATE TEAMS) 123.34,.01 ADMIN. UPDATE TEAM
182 ;
183 ; =================================================================
184 ;
185 ; Variables used:
186 ;
187 ; ORLTEAM = Team IEN, passed in call to this tag.
188 ; ORLTASK = Running via Taskman or not? 0=No, 1=Yes.
189 ; ORLGSTR = String for ^GMR(123.5 subfile.
190 ; ORLGIEN = Temporary GMRC target file IEN holder.
191 ; ORLSIEN = Temporary subfile IEN holder.
192 ;
193 I +ORLTEAM="" Q ; Punt here if there's a problem.
194 Q:'$D(ORLTASK) ; Ditto.
195 N ORLGSTR,ORLGIEN,ORLSIEN
196 ;
197 ; Check for team entry in 123.1,.01 via "AST" x-ref:
198 S ORLGSTR="123.1"
199 S ORLGIEN=0
200 F S ORLGIEN=$O(^GMR(123.5,"AST",ORLTEAM,ORLGIEN)) Q:+ORLGIEN=0 D
201 .S ORLSIEN=0
202 .F S ORLSIEN=$O(^GMR(123.5,"AST",ORLTEAM,ORLGIEN,ORLSIEN)) Q:+ORLSIEN=0 D KPOINT
203 ;
204 ; Check for team entry in 123.2,2 via "ANT" x-ref:
205 S ORLGSTR="123.2"
206 S ORLGIEN=0
207 F S ORLGIEN=$O(^GMR(123.5,"ANT",ORLTEAM,ORLGIEN)) Q:+ORLGIEN=0 D
208 .S ORLSIEN=0
209 .F S ORLSIEN=$O(^GMR(123.5,"ANT",ORLTEAM,ORLGIEN,ORLSIEN)) Q:+ORLSIEN=0 D KPOINT
210 ;
211 ; Check for team entry in 123.31,.01 via "AUT" x-ref:
212 S ORLGSTR="123.31"
213 S ORLGIEN=0
214 F S ORLGIEN=$O(^GMR(123.5,"AUT",ORLTEAM,ORLGIEN)) Q:+ORLGIEN=0 D
215 .S ORLSIEN=0
216 .F S ORLSIEN=$O(^GMR(123.5,"AUT",ORLTEAM,ORLGIEN,ORLSIEN)) Q:+ORLSIEN=0 D KPOINT
217 ;
218 ; Check for team entry in 123.34,.01 via "AAT" x-ref:
219 S ORLGSTR="123.34"
220 S ORLGIEN=0
221 F S ORLGIEN=$O(^GMR(123.5,"AAT",ORLTEAM,ORLGIEN)) Q:+ORLGIEN=0 D
222 .S ORLSIEN=0
223 .F S ORLSIEN=$O(^GMR(123.5,"AAT",ORLTEAM,ORLGIEN,ORLSIEN)) Q:+ORLSIEN=0 D KPOINT
224 ;
225 Q
226 ;
227KPOINT ; Set variables and call DIK to kill the pointer entry.
228 ;
229 N DIK,DA
230 ;
231 S DA=ORLSIEN
232 S DA(1)=ORLGIEN
233 S DIK="^GMR(123.5,"_DA(1)_","_ORLGSTR_","
234 ;
235 ; Wrap locking functionality around call to DIK:
236 L +(^GMR(123.5,ORLGIEN)):0
237 D ^DIK ; User terminated, so call regardless of lock success.
238 L -(^GMR(123.5,ORLGIEN))
239 I ORLTASK D MES^XPDUTL("Pointer to team IEN "_ORLTEAM_" removed from file 123.5, field "_ORLGSTR_" - service IEN "_ORLGIEN_".") ; Installation message to run under Taskman.
240 ;
241 Q
242 ;
Note: See TracBrowser for help on using the repository browser.