GMRCTU ; SLC-SLC/PKS Consults - Terminated users/remove pointers. ; [2/8/00 11:15am]
;;3.0;CONSULT/REQUEST TRACKING;**9**;Dec 27, 1997
;
; OE/RR V3.0 - CONSULTS V3.0
;
; CONSULTS - Removes pointers upon termination.
; The records to be edited are pointers to file #200, NEW PERSON.
;
; ------------------------------------------------------------------
; Enter new files/fields at end of routine under entry label "TEXT."
; ------------------------------------------------------------------
;
; Triggered by Kernel's XU USER TERMINATE event.
; Applicable piece set to null or multiples delted.
; Variable "USER" is DUZ of user for whom pointers will be removed.
; The "USER" value must be passed to the routine by Kernel.
;
; Variables used:
; NPARY = DB array with info on file/field.
; CNT = Overall counter variable.
; INFO = TEXT list variable.
; VALUE = Value match string.
; DIE,DA,DR,X = Used by calls to ^DIE.
; NODE = Node to edit, if applicable.
; PIECE = Piece of node to edit.
; RSTR = Global root file string.
; SSTR = Subfile string.
; FILENUM = File number.
; IEN = IEN string.
; SIEN = Subfile IEN string.
; FIELDNUM = Data Dictionary field number.
; APPSTR = Append string variable.
;
Q
;
EN ; Entry point - called by option: CONSULT TERMINATE CLEANUP.
;
S USER=$GET(XUIFN) ; Assign user variable.
I USER="" Q ; If there's a problem, dump out right now.
D START(USER) ; Call the Control sequence for whole routine.
Q
;
FINDVAL ; See if VALUE (desired USER) exists in the record.
;
S VALUE="" ; Initialize.
;
I SSTR="" D Q ; If no subfile, quit after this IF.
.I $P($G(@(RSTR_+IEN_","_NODE_APPSTR)),"^",PIECE)=USER S VALUE=USER
;
; Process subfiles:
I $P($G(@(RSTR_+IEN_","_SSTR_","_SIEN_","_NODE_APPSTR)),"^",PIECE)=USER S VALUE=USER
;
Q
;
CALLDIE ; Set FM variables and call DIE.
;
N DIE,DA,DR,X
;
I SSTR="" D Q ; No subfile involved.
.S DA=IEN,DIE=RSTR,DR=FIELDNUM_"///^S X=""@"""
.LOCK +@(DIE_IEN_")"):0
.D ^DIE ; User terminated, so call regardless of lock success.
.LOCK -@(DIE_IEN_")")
;
; Process subfile:
S DA(1)=IEN,DA=SIEN,DIE=RSTR_DA(1)_","_SSTR_",",DR=FIELDNUM_"///^S X=""@"""
LOCK +@(DIE_IEN_")"):0
D ^DIE ; User terminated, so call regardless of lock success.
LOCK -@(DIE_IEN_")")
;
Q
;
MAIN ; Outer FOR loop to scan file for IENs, deleting pointer entries.
;
D INFO^GMRCTU1(FILENUM,FIELDNUM,.NPARY) ; DB call, gets information.
;
I (NPARY("DIC",0)="")!(NPARY("LOC")="") Q ; Problems? Dump out.
;
; Assign variables from resulting call:
S (RSTR,SSTR,NODE,PIECE,APPSTR)="" ; Initialize.
S RSTR=NPARY("DIC",1) ; Assign global root string.
;
; If a multiple, set flag and assign subfile string:
I $L($G(NPARY("DIC",2))) S SSTR=$P(NPARY("DIC",2),",",3)
S NODE=$P(NPARY("LOC"),";",1) ; Assign node variable.
S PIECE=$P(NPARY("LOC"),";",2) ; Assign piece variable.
S APPSTR=")" ; Assign append string.
;
; Order through file root entries:
S IEN="" ; Initialize.
;
F S IEN=$O(@(RSTR_+IEN_")")) Q:+IEN=0 D
.I SSTR="" D Q ; Is subfile involved?
..D FINDVAL ; Check for value match.
..I VALUE=USER D CALLDIE ; If a match, clean out pointer entry.
.;
.; Process subfile multiples:
.S SIEN=0 ; Initialize.
.;
.F S SIEN=$O(@(RSTR_+IEN_","_SSTR_","_SIEN_")")) Q:+SIEN=0 D
..D FINDVAL ; Check for value match.
..I VALUE=USER D CALLDIE ; If a match, clean out pointer entry.
;
Q
;
START(USER) ;Control sequence for complete process.
;
N CNT,INFO
S CNT=4 ; Set CNT to first TEXT entry.
;
; Overall loop to get data from TEXT entries (at end of routine):
F D Q:INFO="QUIT"
.N NPARY,VALUE,DIE,DA,DR,X,NODE,PIECE,RSTR,SSTR,FILENUM,IEN,SIEN,FIELDNUM,APPSTR
.S CNT=CNT+1 ; Increment for each TEXT entry.
.S INFO=$P($TEXT(TEXT+CNT),";;",2) ; Get TEXT string.
.Q:INFO="QUIT" ; Finished when no more valid entries are found.
.;
.; Assign two variables from INFO string for each file/field:
.S FILENUM=$P(INFO,",",1)
.S FIELDNUM=$P(INFO,",",2)
.;
.D MAIN ; Proceed to main processing for each file/field.
;
Q
;
; *******************************************************************
;
; Informational comments on files/fields added to TEXT section.
;
; File Name File#,Field Field Name
; ------------------------------------------------------------------
; REQUEST SERVICES 123.5,123.5 SPECIAL UPDATES INDIVIDUAL
; REQUEST SERVICES 123.5,123.08 SERVICE INDIVIDUAL TO NOTIFY
; (NOTIF. BY PT. LOC) 123.54,1 INDIVIDUAL TO NOTIFY
; (UPD. USERS W/O NOT.) 123.55,.01 UPDATE USERS W/O NOTIFICATION
; (ADM. UPDATE USERS) 123.555,.01 ADMINISTRATIVE UPDATE USER
;
; ===================================================================
;
; EXAMPLES of files/pointer entries being removed for above list:
; (Where "777" is the USER) -
;
; ^GMR(123.5,2,0) = MEDICINE^1^^18^777
; ^GMR(123.5,2,123) = 30^1795^2112^^^^^777^11^2199^^
; ^GMR(123.5,2,123.2,2,0) = 1;DIC(42,^777^138
; ^GMR(123.5,2,123.3,7,0) = 777 (<--Multiple)
; ^GMR(123.5,2,123.33,2,0) = 777 (<--Multiple)
;
; *******************************************************************
;
TEXT ; Make entries below for new files/fields for pointer removal.
; DO NOT remove or change the last line.
; Enter comma-delimited lists using DD "pointers in" format:
; Filenumber,Fieldnumber,EntryPersonLocation/Initials
;
;;123.5,123.5,ISC-SLC/PKS
;;123.5,123.08,ISC-SLC/PKS
;;123.54,1,ISC-SLC/PKS
;;123.55,.01,ISC-SLC/PKS
;;123.555,.01,ISC-SLC/PKS
;;QUIT
Q
;
CLNLIST(ORLTEAM,ORLTASK) ; Clean out pointers to 100.21 from 123.5 when a Team List is deleted.
;
; Called by MAIN^ORLPTU (which deletes Personal Team Lists upon
; termination of a sole or last user of the list).
;
; Called by DEL^ORLP1 (when a non-Personal Team List is deleted).
;
; Called by DEL^ORLP3U2 (when a Personal Team List is deleted
; by menu action.
;
; The following pointers from 123.5 are processed here:
;
; Subfile Name File#,Field Field Name
; ----------------------------------------------------------------
; (SERVICE TEAM(S) TO NOTIFY) 123.1,.01 SERVICE TEAM TO NOTIFY
; (NOTIF. BY PT LOCATION) 123.2,2 TEAM TO NOTIFY
; (UPD. TEAMS W/O NOT.) 123.31,.01 UPDATE TEAMS W/O NOTIF.
; (ADM. UPDATE TEAMS) 123.34,.01 ADMIN. UPDATE TEAM
;
; =================================================================
;
; Variables used:
;
; ORLTEAM = Team IEN, passed in call to this tag.
; ORLTASK = Running via Taskman or not? 0=No, 1=Yes.
; ORLGSTR = String for ^GMR(123.5 subfile.
; ORLGIEN = Temporary GMRC target file IEN holder.
; ORLSIEN = Temporary subfile IEN holder.
;
I +ORLTEAM="" Q ; Punt here if there's a problem.
Q:'$D(ORLTASK) ; Ditto.
N ORLGSTR,ORLGIEN,ORLSIEN
;
; Check for team entry in 123.1,.01 via "AST" x-ref:
S ORLGSTR="123.1"
S ORLGIEN=0
F S ORLGIEN=$O(^GMR(123.5,"AST",ORLTEAM,ORLGIEN)) Q:+ORLGIEN=0 D
.S ORLSIEN=0
.F S ORLSIEN=$O(^GMR(123.5,"AST",ORLTEAM,ORLGIEN,ORLSIEN)) Q:+ORLSIEN=0 D KPOINT
;
; Check for team entry in 123.2,2 via "ANT" x-ref:
S ORLGSTR="123.2"
S ORLGIEN=0
F S ORLGIEN=$O(^GMR(123.5,"ANT",ORLTEAM,ORLGIEN)) Q:+ORLGIEN=0 D
.S ORLSIEN=0
.F S ORLSIEN=$O(^GMR(123.5,"ANT",ORLTEAM,ORLGIEN,ORLSIEN)) Q:+ORLSIEN=0 D KPOINT
;
; Check for team entry in 123.31,.01 via "AUT" x-ref:
S ORLGSTR="123.31"
S ORLGIEN=0
F S ORLGIEN=$O(^GMR(123.5,"AUT",ORLTEAM,ORLGIEN)) Q:+ORLGIEN=0 D
.S ORLSIEN=0
.F S ORLSIEN=$O(^GMR(123.5,"AUT",ORLTEAM,ORLGIEN,ORLSIEN)) Q:+ORLSIEN=0 D KPOINT
;
; Check for team entry in 123.34,.01 via "AAT" x-ref:
S ORLGSTR="123.34"
S ORLGIEN=0
F S ORLGIEN=$O(^GMR(123.5,"AAT",ORLTEAM,ORLGIEN)) Q:+ORLGIEN=0 D
.S ORLSIEN=0
.F S ORLSIEN=$O(^GMR(123.5,"AAT",ORLTEAM,ORLGIEN,ORLSIEN)) Q:+ORLSIEN=0 D KPOINT
;
Q
;
KPOINT ; Set variables and call DIK to kill the pointer entry.
;
N DIK,DA
;
S DA=ORLSIEN
S DA(1)=ORLGIEN
S DIK="^GMR(123.5,"_DA(1)_","_ORLGSTR_","
;
; Wrap locking functionality around call to DIK:
L +(^GMR(123.5,ORLGIEN)):0
D ^DIK ; User terminated, so call regardless of lock success.
L -(^GMR(123.5,ORLGIEN))
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.
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCTU 8812 printed Sep 23, 2025@19:23:43 Page 2
GMRCTU ; SLC-SLC/PKS Consults - Terminated users/remove pointers. ; [2/8/00 11:15am]
+1 ;;3.0;CONSULT/REQUEST TRACKING;**9**;Dec 27, 1997
+2 ;
+3 ; OE/RR V3.0 - CONSULTS V3.0
+4 ;
+5 ; CONSULTS - Removes pointers upon termination.
+6 ; The records to be edited are pointers to file #200, NEW PERSON.
+7 ;
+8 ; ------------------------------------------------------------------
+9 ; Enter new files/fields at end of routine under entry label "TEXT."
+10 ; ------------------------------------------------------------------
+11 ;
+12 ; Triggered by Kernel's XU USER TERMINATE event.
+13 ; Applicable piece set to null or multiples delted.
+14 ; Variable "USER" is DUZ of user for whom pointers will be removed.
+15 ; The "USER" value must be passed to the routine by Kernel.
+16 ;
+17 ; Variables used:
+18 ; NPARY = DB array with info on file/field.
+19 ; CNT = Overall counter variable.
+20 ; INFO = TEXT list variable.
+21 ; VALUE = Value match string.
+22 ; DIE,DA,DR,X = Used by calls to ^DIE.
+23 ; NODE = Node to edit, if applicable.
+24 ; PIECE = Piece of node to edit.
+25 ; RSTR = Global root file string.
+26 ; SSTR = Subfile string.
+27 ; FILENUM = File number.
+28 ; IEN = IEN string.
+29 ; SIEN = Subfile IEN string.
+30 ; FIELDNUM = Data Dictionary field number.
+31 ; APPSTR = Append string variable.
+32 ;
+33 QUIT
+34 ;
EN ; Entry point - called by option: CONSULT TERMINATE CLEANUP.
+1 ;
+2 ; Assign user variable.
SET USER=$GET(XUIFN)
+3 ; If there's a problem, dump out right now.
IF USER=""
QUIT
+4 ; Call the Control sequence for whole routine.
DO START(USER)
+5 QUIT
+6 ;
FINDVAL ; See if VALUE (desired USER) exists in the record.
+1 ;
+2 ; Initialize.
SET VALUE=""
+3 ;
+4 ; If no subfile, quit after this IF.
IF SSTR=""
Begin DoDot:1
+5 IF $PIECE($GET(@(RSTR_+IEN_","_NODE_APPSTR)),"^",PIECE)=USER
SET VALUE=USER
End DoDot:1
QUIT
+6 ;
+7 ; Process subfiles:
+8 IF $PIECE($GET(@(RSTR_+IEN_","_SSTR_","_SIEN_","_NODE_APPSTR)),"^",PIECE)=USER
SET VALUE=USER
+9 ;
+10 QUIT
+11 ;
CALLDIE ; Set FM variables and call DIE.
+1 ;
+2 NEW DIE,DA,DR,X
+3 ;
+4 ; No subfile involved.
IF SSTR=""
Begin DoDot:1
+5 SET DA=IEN
SET DIE=RSTR
SET DR=FIELDNUM_"///^S X=""@"""
+6 LOCK +@(DIE_IEN_")"):0
+7 ; User terminated, so call regardless of lock success.
DO ^DIE
+8 LOCK -@(DIE_IEN_")")
End DoDot:1
QUIT
+9 ;
+10 ; Process subfile:
+11 SET DA(1)=IEN
SET DA=SIEN
SET DIE=RSTR_DA(1)_","_SSTR_","
SET DR=FIELDNUM_"///^S X=""@"""
+12 LOCK +@(DIE_IEN_")"):0
+13 ; User terminated, so call regardless of lock success.
DO ^DIE
+14 LOCK -@(DIE_IEN_")")
+15 ;
+16 QUIT
+17 ;
MAIN ; Outer FOR loop to scan file for IENs, deleting pointer entries.
+1 ;
+2 ; DB call, gets information.
DO INFO^GMRCTU1(FILENUM,FIELDNUM,.NPARY)
+3 ;
+4 ; Problems? Dump out.
IF (NPARY("DIC",0)="")!(NPARY("LOC")="")
QUIT
+5 ;
+6 ; Assign variables from resulting call:
+7 ; Initialize.
SET (RSTR,SSTR,NODE,PIECE,APPSTR)=""
+8 ; Assign global root string.
SET RSTR=NPARY("DIC",1)
+9 ;
+10 ; If a multiple, set flag and assign subfile string:
+11 IF $LENGTH($GET(NPARY("DIC",2)))
SET SSTR=$PIECE(NPARY("DIC",2),",",3)
+12 ; Assign node variable.
SET NODE=$PIECE(NPARY("LOC"),";",1)
+13 ; Assign piece variable.
SET PIECE=$PIECE(NPARY("LOC"),";",2)
+14 ; Assign append string.
SET APPSTR=")"
+15 ;
+16 ; Order through file root entries:
+17 ; Initialize.
SET IEN=""
+18 ;
+19 FOR
SET IEN=$ORDER(@(RSTR_+IEN_")"))
if +IEN=0
QUIT
Begin DoDot:1
+20 ; Is subfile involved?
IF SSTR=""
Begin DoDot:2
+21 ; Check for value match.
DO FINDVAL
+22 ; If a match, clean out pointer entry.
IF VALUE=USER
DO CALLDIE
End DoDot:2
QUIT
+23 ;
+24 ; Process subfile multiples:
+25 ; Initialize.
SET SIEN=0
+26 ;
+27 FOR
SET SIEN=$ORDER(@(RSTR_+IEN_","_SSTR_","_SIEN_")"))
if +SIEN=0
QUIT
Begin DoDot:2
+28 ; Check for value match.
DO FINDVAL
+29 ; If a match, clean out pointer entry.
IF VALUE=USER
DO CALLDIE
End DoDot:2
End DoDot:1
+30 ;
+31 QUIT
+32 ;
START(USER) ;Control sequence for complete process.
+1 ;
+2 NEW CNT,INFO
+3 ; Set CNT to first TEXT entry.
SET CNT=4
+4 ;
+5 ; Overall loop to get data from TEXT entries (at end of routine):
+6 FOR
Begin DoDot:1
+7 NEW NPARY,VALUE,DIE,DA,DR,X,NODE,PIECE,RSTR,SSTR,FILENUM,IEN,SIEN,FIELDNUM,APPSTR
+8 ; Increment for each TEXT entry.
SET CNT=CNT+1
+9 ; Get TEXT string.
SET INFO=$PIECE($TEXT(TEXT+CNT),";;",2)
+10 ; Finished when no more valid entries are found.
if INFO="QUIT"
QUIT
+11 ;
+12 ; Assign two variables from INFO string for each file/field:
+13 SET FILENUM=$PIECE(INFO,",",1)
+14 SET FIELDNUM=$PIECE(INFO,",",2)
+15 ;
+16 ; Proceed to main processing for each file/field.
DO MAIN
End DoDot:1
if INFO="QUIT"
QUIT
+17 ;
+18 QUIT
+19 ;
+20 ; *******************************************************************
+21 ;
+22 ; Informational comments on files/fields added to TEXT section.
+23 ;
+24 ; File Name File#,Field Field Name
+25 ; ------------------------------------------------------------------
+26 ; REQUEST SERVICES 123.5,123.5 SPECIAL UPDATES INDIVIDUAL
+27 ; REQUEST SERVICES 123.5,123.08 SERVICE INDIVIDUAL TO NOTIFY
+28 ; (NOTIF. BY PT. LOC) 123.54,1 INDIVIDUAL TO NOTIFY
+29 ; (UPD. USERS W/O NOT.) 123.55,.01 UPDATE USERS W/O NOTIFICATION
+30 ; (ADM. UPDATE USERS) 123.555,.01 ADMINISTRATIVE UPDATE USER
+31 ;
+32 ; ===================================================================
+33 ;
+34 ; EXAMPLES of files/pointer entries being removed for above list:
+35 ; (Where "777" is the USER) -
+36 ;
+37 ; ^GMR(123.5,2,0) = MEDICINE^1^^18^777
+38 ; ^GMR(123.5,2,123) = 30^1795^2112^^^^^777^11^2199^^
+39 ; ^GMR(123.5,2,123.2,2,0) = 1;DIC(42,^777^138
+40 ; ^GMR(123.5,2,123.3,7,0) = 777 (<--Multiple)
+41 ; ^GMR(123.5,2,123.33,2,0) = 777 (<--Multiple)
+42 ;
+43 ; *******************************************************************
+44 ;
TEXT ; Make entries below for new files/fields for pointer removal.
+1 ; DO NOT remove or change the last line.
+2 ; Enter comma-delimited lists using DD "pointers in" format:
+3 ; Filenumber,Fieldnumber,EntryPersonLocation/Initials
+4 ;
+5 ;;123.5,123.5,ISC-SLC/PKS
+6 ;;123.5,123.08,ISC-SLC/PKS
+7 ;;123.54,1,ISC-SLC/PKS
+8 ;;123.55,.01,ISC-SLC/PKS
+9 ;;123.555,.01,ISC-SLC/PKS
+10 ;;QUIT
+11 QUIT
+12 ;
CLNLIST(ORLTEAM,ORLTASK) ; Clean out pointers to 100.21 from 123.5 when a Team List is deleted.
+1 ;
+2 ; Called by MAIN^ORLPTU (which deletes Personal Team Lists upon
+3 ; termination of a sole or last user of the list).
+4 ;
+5 ; Called by DEL^ORLP1 (when a non-Personal Team List is deleted).
+6 ;
+7 ; Called by DEL^ORLP3U2 (when a Personal Team List is deleted
+8 ; by menu action.
+9 ;
+10 ; The following pointers from 123.5 are processed here:
+11 ;
+12 ; Subfile Name File#,Field Field Name
+13 ; ----------------------------------------------------------------
+14 ; (SERVICE TEAM(S) TO NOTIFY) 123.1,.01 SERVICE TEAM TO NOTIFY
+15 ; (NOTIF. BY PT LOCATION) 123.2,2 TEAM TO NOTIFY
+16 ; (UPD. TEAMS W/O NOT.) 123.31,.01 UPDATE TEAMS W/O NOTIF.
+17 ; (ADM. UPDATE TEAMS) 123.34,.01 ADMIN. UPDATE TEAM
+18 ;
+19 ; =================================================================
+20 ;
+21 ; Variables used:
+22 ;
+23 ; ORLTEAM = Team IEN, passed in call to this tag.
+24 ; ORLTASK = Running via Taskman or not? 0=No, 1=Yes.
+25 ; ORLGSTR = String for ^GMR(123.5 subfile.
+26 ; ORLGIEN = Temporary GMRC target file IEN holder.
+27 ; ORLSIEN = Temporary subfile IEN holder.
+28 ;
+29 ; Punt here if there's a problem.
IF +ORLTEAM=""
QUIT
+30 ; Ditto.
if '$DATA(ORLTASK)
QUIT
+31 NEW ORLGSTR,ORLGIEN,ORLSIEN
+32 ;
+33 ; Check for team entry in 123.1,.01 via "AST" x-ref:
+34 SET ORLGSTR="123.1"
+35 SET ORLGIEN=0
+36 FOR
SET ORLGIEN=$ORDER(^GMR(123.5,"AST",ORLTEAM,ORLGIEN))
if +ORLGIEN=0
QUIT
Begin DoDot:1
+37 SET ORLSIEN=0
+38 FOR
SET ORLSIEN=$ORDER(^GMR(123.5,"AST",ORLTEAM,ORLGIEN,ORLSIEN))
if +ORLSIEN=0
QUIT
DO KPOINT
End DoDot:1
+39 ;
+40 ; Check for team entry in 123.2,2 via "ANT" x-ref:
+41 SET ORLGSTR="123.2"
+42 SET ORLGIEN=0
+43 FOR
SET ORLGIEN=$ORDER(^GMR(123.5,"ANT",ORLTEAM,ORLGIEN))
if +ORLGIEN=0
QUIT
Begin DoDot:1
+44 SET ORLSIEN=0
+45 FOR
SET ORLSIEN=$ORDER(^GMR(123.5,"ANT",ORLTEAM,ORLGIEN,ORLSIEN))
if +ORLSIEN=0
QUIT
DO KPOINT
End DoDot:1
+46 ;
+47 ; Check for team entry in 123.31,.01 via "AUT" x-ref:
+48 SET ORLGSTR="123.31"
+49 SET ORLGIEN=0
+50 FOR
SET ORLGIEN=$ORDER(^GMR(123.5,"AUT",ORLTEAM,ORLGIEN))
if +ORLGIEN=0
QUIT
Begin DoDot:1
+51 SET ORLSIEN=0
+52 FOR
SET ORLSIEN=$ORDER(^GMR(123.5,"AUT",ORLTEAM,ORLGIEN,ORLSIEN))
if +ORLSIEN=0
QUIT
DO KPOINT
End DoDot:1
+53 ;
+54 ; Check for team entry in 123.34,.01 via "AAT" x-ref:
+55 SET ORLGSTR="123.34"
+56 SET ORLGIEN=0
+57 FOR
SET ORLGIEN=$ORDER(^GMR(123.5,"AAT",ORLTEAM,ORLGIEN))
if +ORLGIEN=0
QUIT
Begin DoDot:1
+58 SET ORLSIEN=0
+59 FOR
SET ORLSIEN=$ORDER(^GMR(123.5,"AAT",ORLTEAM,ORLGIEN,ORLSIEN))
if +ORLSIEN=0
QUIT
DO KPOINT
End DoDot:1
+60 ;
+61 QUIT
+62 ;
KPOINT ; Set variables and call DIK to kill the pointer entry.
+1 ;
+2 NEW DIK,DA
+3 ;
+4 SET DA=ORLSIEN
+5 SET DA(1)=ORLGIEN
+6 SET DIK="^GMR(123.5,"_DA(1)_","_ORLGSTR_","
+7 ;
+8 ; Wrap locking functionality around call to DIK:
+9 LOCK +(^GMR(123.5,ORLGIEN)):0
+10 ; User terminated, so call regardless of lock success.
DO ^DIK
+11 LOCK -(^GMR(123.5,ORLGIEN))
+12 ; Installation message to run under Taskman.
IF ORLTASK
DO MES^XPDUTL("Pointer to team IEN "_ORLTEAM_" removed from file 123.5, field "_ORLGSTR_" - service IEN "_ORLGIEN_".")
+13 ;
+14 QUIT
+15 ;
