- 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 Jan 18, 2025@02:48:54 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 ;