ORLPTU ; SLC/PKS OE/RR - Terminated users, pointer removal. ; [3/13/00 1:04pm]
;;3.0;ORDER ENTRY/RESULTS REPORTING;**44**;Dec 17, 1997
;
; OE/RR - Remove pointers from team lists file.
; The records to be edited are pointers to file #200, NEW PERSON.
; Routine is triggered by Kernel's XU USER TERMINATE event.
;
; This routine also removes the complete team list record from
; team file ^OR(100.21 if the Team List involved is a Personal
; type list and the terminated user is the only user on the list.
;
; Entries are removed from the following files::
;
; File Name File#,Field# Field Name
; -------------------------------------------------------------
; OE/RR LIST 100.21,2 USER
; OE/RR LIST 100.21,3 AUTOLINK
;
; The first example is a subfile multiple pointer and DINUM field.
; The second example is a subfile multiple variable pointer.
; Variable "USER" is DUZ of user for whom entries will be removed;
; it's value must be available to the routine from Kernel.
;
; =============================================================
;
; EXAMPLES of file entries with pointers being removed:
; (Where "777" is the USER) -
;
; ^OR(100.21,140,1,777,0) = 777
; ^OR(100,21,140,2,1,0) = 777;VA(200,^B
;
; =============================================================
;
; Variables used:
;
; USER = DUZ of terminated user.
; DIK,DA = Used by call to ^DIK.
; RFILE = Root file.
; IEN = Record IEN.
; SIEN = Subfile IEN.
; TEAM = IEN of team to kill if terminated user is only user.
; ORYDAT = File data holder.
;
; -------------------------------------------------------------
;
Q
;
PASS(TU) ; TU (Terminated User = USER variable) sent in call at this tag.
;
N USER
S USER=TU ; Assign USER variable.
I USER="" Q ; Punt right away if there's a problem.
D MAIN ; Skip next tag, go to main processing.
Q
;
KUSER ; Get USER from kernel - called by option: OR TERMINATE CLEANUP.
;
N USER
S USER=$GET(XUIFN) ; Assign USER variable.
I USER="" Q ; Punt here if there's a problem.
;
MAIN ; Processing portion of routine.
;
N DIK,DA,RFILE,IEN,TEAM,CNT,SIEN,ORYDAT
;
; Order through the file for each team:
S RFILE="^OR(100.21," ; Assign root file string.
S IEN=0 ; Initialize.
;
F S IEN=$ORDER(^OR(100.21,IEN)) Q:+IEN=0 D ; Each team.
.S TEAM=""
.S CNT=0
.S SIEN=0
.;
.; Check and remove user from teams as applicable:
.F CNT=0:1 S SIEN=$ORDER(^OR(100.21,IEN,1,SIEN)) Q:+SIEN=0 D
..I SIEN=USER D ; If user is on team, set FM vars and call DIK.
...N DA
...S DA=SIEN,DA(1)=IEN,DIK=RFILE_DA(1)_",1,"
...D ^DIK
...;
...; Set up for possible team kill if team type is "P" (Personal):
...I $P(^OR(100.21,IEN,0),"^",2)="P" S TEAM=IEN
.;
.; Check and remove user for AUTOLINKS if found:
.S SIEN=0 ; Initialize again.
.F S SIEN=$O(^OR(100.21,IEN,2,SIEN)) Q:+SIEN=0 D
..I +(^OR(100.21,IEN,2,SIEN,0))=USER D
...;
...; Check for correct type of AUTOLINK:
...S ORYDAT="^OR(100.21,"_IEN_",2,"_SIEN_",0)"
...I $G(@ORYDAT)'["VA" Q ; Not a ^VA(200 file pointer.
...;
...N DA
...S DA=SIEN,DA(1)=IEN,DIK=RFILE_DA(1)_",2,"
...D ^DIK
.;
.; Remove team entry altogether if terminated user is only user:
.I CNT=1&'(TEAM="") D ; Set FM vars, call DIK, kill team entry.
..N DA
..S DA=TEAM,DIK=RFILE
..D ^DIK
..;
..; Call tag/routine to clean up pointers to the list in file 123.5:
..D CLNLIST^GMRCTU(TEAM,0)
;
Q
;
ORLPTU ; SLC/PKS OE/RR - Terminated users, pointer removal. ; [3/13/00 1:04pm]
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**44**;Dec 17, 1997
+2 ;
+3 ; OE/RR - Remove pointers from team lists file.
+4 ; The records to be edited are pointers to file #200, NEW PERSON.
+5 ; Routine is triggered by Kernel's XU USER TERMINATE event.
+6 ;
+7 ; This routine also removes the complete team list record from
+8 ; team file ^OR(100.21 if the Team List involved is a Personal
+9 ; type list and the terminated user is the only user on the list.
+10 ;
+11 ; Entries are removed from the following files::
+12 ;
+13 ; File Name File#,Field# Field Name
+14 ; -------------------------------------------------------------
+15 ; OE/RR LIST 100.21,2 USER
+16 ; OE/RR LIST 100.21,3 AUTOLINK
+17 ;
+18 ; The first example is a subfile multiple pointer and DINUM field.
+19 ; The second example is a subfile multiple variable pointer.
+20 ; Variable "USER" is DUZ of user for whom entries will be removed;
+21 ; it's value must be available to the routine from Kernel.
+22 ;
+23 ; =============================================================
+24 ;
+25 ; EXAMPLES of file entries with pointers being removed:
+26 ; (Where "777" is the USER) -
+27 ;
+28 ; ^OR(100.21,140,1,777,0) = 777
+29 ; ^OR(100,21,140,2,1,0) = 777;VA(200,^B
+30 ;
+31 ; =============================================================
+32 ;
+33 ; Variables used:
+34 ;
+35 ; USER = DUZ of terminated user.
+36 ; DIK,DA = Used by call to ^DIK.
+37 ; RFILE = Root file.
+38 ; IEN = Record IEN.
+39 ; SIEN = Subfile IEN.
+40 ; TEAM = IEN of team to kill if terminated user is only user.
+41 ; ORYDAT = File data holder.
+42 ;
+43 ; -------------------------------------------------------------
+44 ;
+45 QUIT
+46 ;
PASS(TU) ; TU (Terminated User = USER variable) sent in call at this tag.
+1 ;
+2 NEW USER
+3 ; Assign USER variable.
SET USER=TU
+4 ; Punt right away if there's a problem.
IF USER=""
QUIT
+5 ; Skip next tag, go to main processing.
DO MAIN
+6 QUIT
+7 ;
KUSER ; Get USER from kernel - called by option: OR TERMINATE CLEANUP.
+1 ;
+2 NEW USER
+3 ; Assign USER variable.
SET USER=$GET(XUIFN)
+4 ; Punt here if there's a problem.
IF USER=""
QUIT
+5 ;
MAIN ; Processing portion of routine.
+1 ;
+2 NEW DIK,DA,RFILE,IEN,TEAM,CNT,SIEN,ORYDAT
+3 ;
+4 ; Order through the file for each team:
+5 ; Assign root file string.
SET RFILE="^OR(100.21,"
+6 ; Initialize.
SET IEN=0
+7 ;
+8 ; Each team.
FOR
SET IEN=$ORDER(^OR(100.21,IEN))
IF +IEN=0
QUIT
Begin DoDot:1
+9 SET TEAM=""
+10 SET CNT=0
+11 SET SIEN=0
+12 ;
+13 ; Check and remove user from teams as applicable:
+14 FOR CNT=0:1
SET SIEN=$ORDER(^OR(100.21,IEN,1,SIEN))
IF +SIEN=0
QUIT
Begin DoDot:2
+15 ; If user is on team, set FM vars and call DIK.
IF SIEN=USER
Begin DoDot:3
+16 NEW DA
+17 SET DA=SIEN
SET DA(1)=IEN
SET DIK=RFILE_DA(1)_",1,"
+18 DO ^DIK
+19 ;
+20 ; Set up for possible team kill if team type is "P" (Personal):
+21 IF $PIECE(^OR(100.21,IEN,0),"^",2)="P"
SET TEAM=IEN
End DoDot:3
End DoDot:2
+22 ;
+23 ; Check and remove user for AUTOLINKS if found:
+24 ; Initialize again.
SET SIEN=0
+25 FOR
SET SIEN=$ORDER(^OR(100.21,IEN,2,SIEN))
IF +SIEN=0
QUIT
Begin DoDot:2
+26 IF +(^OR(100.21,IEN,2,SIEN,0))=USER
Begin DoDot:3
+27 ;
+28 ; Check for correct type of AUTOLINK:
+29 SET ORYDAT="^OR(100.21,"_IEN_",2,"_SIEN_",0)"
+30 ; Not a ^VA(200 file pointer.
IF $GET(@ORYDAT)'["VA"
QUIT
+31 ;
+32 NEW DA
+33 SET DA=SIEN
SET DA(1)=IEN
SET DIK=RFILE_DA(1)_",2,"
+34 DO ^DIK
End DoDot:3
End DoDot:2
+35 ;
+36 ; Remove team entry altogether if terminated user is only user:
+37 ; Set FM vars, call DIK, kill team entry.
IF CNT=1&'(TEAM="")
Begin DoDot:2
+38 NEW DA
+39 SET DA=TEAM
SET DIK=RFILE
+40 DO ^DIK
+41 ;
+42 ; Call tag/routine to clean up pointers to the list in file 123.5:
+43 DO CLNLIST^GMRCTU(TEAM,0)
End DoDot:2
End DoDot:1
+44 ;
+45 QUIT
+46 ;
