source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORLPTU.m@ 1803

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

initial load of FOIAVistA 6/30/08 version

File size: 3.4 KB
Line 
1ORLPTU ; SLC/PKS OE/RR - Terminated users, pointer removal. ; [3/13/00 1:04pm]
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**44**;Dec 17, 1997
3 ;
4 ; OE/RR - Remove pointers from team lists file.
5 ; The records to be edited are pointers to file #200, NEW PERSON.
6 ; Routine is triggered by Kernel's XU USER TERMINATE event.
7 ;
8 ; This routine also removes the complete team list record from
9 ; team file ^OR(100.21 if the Team List involved is a Personal
10 ; type list and the terminated user is the only user on the list.
11 ;
12 ; Entries are removed from the following files::
13 ;
14 ; File Name File#,Field# Field Name
15 ; -------------------------------------------------------------
16 ; OE/RR LIST 100.21,2 USER
17 ; OE/RR LIST 100.21,3 AUTOLINK
18 ;
19 ; The first example is a subfile multiple pointer and DINUM field.
20 ; The second example is a subfile multiple variable pointer.
21 ; Variable "USER" is DUZ of user for whom entries will be removed;
22 ; it's value must be available to the routine from Kernel.
23 ;
24 ; =============================================================
25 ;
26 ; EXAMPLES of file entries with pointers being removed:
27 ; (Where "777" is the USER) -
28 ;
29 ; ^OR(100.21,140,1,777,0) = 777
30 ; ^OR(100,21,140,2,1,0) = 777;VA(200,^B
31 ;
32 ; =============================================================
33 ;
34 ; Variables used:
35 ;
36 ; USER = DUZ of terminated user.
37 ; DIK,DA = Used by call to ^DIK.
38 ; RFILE = Root file.
39 ; IEN = Record IEN.
40 ; SIEN = Subfile IEN.
41 ; TEAM = IEN of team to kill if terminated user is only user.
42 ; ORYDAT = File data holder.
43 ;
44 ; -------------------------------------------------------------
45 ;
46 Q
47 ;
48PASS(TU) ; TU (Terminated User = USER variable) sent in call at this tag.
49 ;
50 N USER
51 S USER=TU ; Assign USER variable.
52 I USER="" Q ; Punt right away if there's a problem.
53 D MAIN ; Skip next tag, go to main processing.
54 Q
55 ;
56KUSER ; Get USER from kernel - called by option: OR TERMINATE CLEANUP.
57 ;
58 N USER
59 S USER=$GET(XUIFN) ; Assign USER variable.
60 I USER="" Q ; Punt here if there's a problem.
61 ;
62MAIN ; Processing portion of routine.
63 ;
64 N DIK,DA,RFILE,IEN,TEAM,CNT,SIEN,ORYDAT
65 ;
66 ; Order through the file for each team:
67 S RFILE="^OR(100.21," ; Assign root file string.
68 S IEN=0 ; Initialize.
69 ;
70 F S IEN=$ORDER(^OR(100.21,IEN)) Q:+IEN=0 D ; Each team.
71 .S TEAM=""
72 .S CNT=0
73 .S SIEN=0
74 .;
75 .; Check and remove user from teams as applicable:
76 .F CNT=0:1 S SIEN=$ORDER(^OR(100.21,IEN,1,SIEN)) Q:+SIEN=0 D
77 ..I SIEN=USER D ; If user is on team, set FM vars and call DIK.
78 ...N DA
79 ...S DA=SIEN,DA(1)=IEN,DIK=RFILE_DA(1)_",1,"
80 ...D ^DIK
81 ...;
82 ...; Set up for possible team kill if team type is "P" (Personal):
83 ...I $P(^OR(100.21,IEN,0),"^",2)="P" S TEAM=IEN
84 .;
85 .; Check and remove user for AUTOLINKS if found:
86 .S SIEN=0 ; Initialize again.
87 .F S SIEN=$O(^OR(100.21,IEN,2,SIEN)) Q:+SIEN=0 D
88 ..I +(^OR(100.21,IEN,2,SIEN,0))=USER D
89 ...;
90 ...; Check for correct type of AUTOLINK:
91 ...S ORYDAT="^OR(100.21,"_IEN_",2,"_SIEN_",0)"
92 ...I $G(@ORYDAT)'["VA" Q ; Not a ^VA(200 file pointer.
93 ...;
94 ...N DA
95 ...S DA=SIEN,DA(1)=IEN,DIK=RFILE_DA(1)_",2,"
96 ...D ^DIK
97 .;
98 .; Remove team entry altogether if terminated user is only user:
99 .I CNT=1&'(TEAM="") D ; Set FM vars, call DIK, kill team entry.
100 ..N DA
101 ..S DA=TEAM,DIK=RFILE
102 ..D ^DIK
103 ..;
104 ..; Call tag/routine to clean up pointers to the list in file 123.5:
105 ..D CLNLIST^GMRCTU(TEAM,0)
106 ;
107 Q
108 ;
Note: See TracBrowser for help on using the repository browser.