| 1 | GMRCTU ; 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 | ;
|
|---|
| 36 | EN ; 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 | ;
|
|---|
| 43 | FINDVAL ; 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 | ;
|
|---|
| 55 | CALLDIE ; 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 | ;
|
|---|
| 73 | MAIN ; 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 | ;
|
|---|
| 106 | START(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 | ;
|
|---|
| 151 | TEXT ; 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 | ;
|
|---|
| 164 | CLNLIST(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 | ;
|
|---|
| 227 | KPOINT ; 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 | ;
|
|---|
