| 1 | %ZIBCLU0 ; IHS/ADC/GTH - GENERAL PURPOSE CLEAN UP UTILITY GLOBALS ; [ 02/07/97 3:02 PM ]
|
|---|
| 2 | ;;4.0;XB;;Jul 20, 2009;Build 2
|
|---|
| 3 | EN ;
|
|---|
| 4 | Q:'($ZV?1"MSM".E!($ZV?1"DSM".E)) ; Only works for MSM or DSM.
|
|---|
| 5 | S ZIBOS=$ZV ; Set operating system.
|
|---|
| 6 | D @$S(ZIBOS?1"DSM".E:"DSM",1:"MSM") ; Active JOB lookup per operating system.
|
|---|
| 7 | D XUT ; Cleanup the ^XUTL global.
|
|---|
| 8 | F ZIBGR="^ZUT(","^UTILITY(" D GO ; Check the ^ZUT and ^UTILITY globals for nodes to be removed.
|
|---|
| 9 | D OUT ; KILL off variables and exit gracefully.
|
|---|
| 10 | Q
|
|---|
| 11 | ;
|
|---|
| 12 | MSM ; MSM specific look up of active JOBs.
|
|---|
| 13 | S $ZT="MER^%ZIBCLU0"
|
|---|
| 14 | V 44:$J:$ZB($V(44,$J,2),1,7):2
|
|---|
| 15 | S ZIBST=$V(44),ZIBSTA=$V(ZIBST+8,-3,2)+ZIBST,ZIBMXJ=$V($V(ZIBST+284),-3,4),ZIBPT=$V(3*4+ZIBSTA)
|
|---|
| 16 | ; Build active JOB table (ZIBJT).
|
|---|
| 17 | F ZIBJ=1:1:ZIBMXJ S:$V(ZIBJ*4+ZIBPT) ZIBJT(ZIBJ)=$ZU(($V(2,ZIBJ,2)#32),($V(2,ZIBJ,2)\32))
|
|---|
| 18 | Q
|
|---|
| 19 | ;
|
|---|
| 20 | MER ;EP - MSM error trap.
|
|---|
| 21 | V 44:$J:$ZB($V(44,$J,2),#FFFE,1):2
|
|---|
| 22 | ZQ
|
|---|
| 23 | ;
|
|---|
| 24 | DSM ; DSM specific look up of active JOBs.
|
|---|
| 25 | S ZIBST=$V(44),ZIBSJT=$V(ZIBST+4)
|
|---|
| 26 | ; Build active JOB table (ZIBJT).
|
|---|
| 27 | F ZIBI=ZIBSJT+2:2:ZIBSJT+126 I $V(ZIBI+1),$V(ZIBI+1)'=244 S ZIBJ=ZIBI-ZIBSJT\2 S:ZIBJ]"" ZIBJT(ZIBJ)=$ZU(($V(149,ZIBJ)#32),($V(149,ZIBJ)\32))
|
|---|
| 28 | S ZIBJT($J)=$ZU(0) ; Put this JOB and UCI in the JOB table.
|
|---|
| 29 | KILL ZIBSJT
|
|---|
| 30 | Q
|
|---|
| 31 | ;
|
|---|
| 32 | XUT ; Clenaup ^XUTL in MGR separate from other UCIs.
|
|---|
| 33 | I $ZU(0)?1"MGR".E D
|
|---|
| 34 | . S ZIBJ=""
|
|---|
| 35 | . F S ZIBJ=$O(^XUTL("XQ",ZIBJ)) Q:ZIBJ="" KILL:'$D(ZIBJT(ZIBJ)) ^(ZIBJ)
|
|---|
| 36 | E D
|
|---|
| 37 | .S ZIBJ=""
|
|---|
| 38 | .S ZIBK=1 ; Set KILL flag ON - Set OFF if other JOBs active in this UCI
|
|---|
| 39 | .F S ZIBJ=$O(ZIBJT(ZIBJ)) Q:ZIBJ="" S:ZIBJ'=$J&(ZIBJT(ZIBJ)=$ZU(0)) ZIBK=0
|
|---|
| 40 | .I ZIBK S ZIBX="" F S ZIBX=$O(^XUTL(ZIBX)) Q:ZIBX="" KILL ^(ZIBX)
|
|---|
| 41 | Q
|
|---|
| 42 | ;
|
|---|
| 43 | GO ; $O down ^ZUT or ^UTILITY looking for (jobnbr OR (namespace,jobnbr
|
|---|
| 44 | S ZIBX1=""
|
|---|
| 45 | F S (ZIBA,ZIBJ,ZIBX1)=$O(@(ZIBGR_""""_ZIBX1_""")")) Q:ZIBX1="" D @$S(ZIBX1?1N.N:"N1",1:"N2")
|
|---|
| 46 | GOQ ;
|
|---|
| 47 | Q
|
|---|
| 48 | ;
|
|---|
| 49 | N1 ; Check first subscript value and remove if its a dangling node.
|
|---|
| 50 | I ZIBOS?1"MSM".E,ZIBX1="%ER" D N2 G N1Q
|
|---|
| 51 | D RM
|
|---|
| 52 | N1Q ;
|
|---|
| 53 | Q
|
|---|
| 54 | ;
|
|---|
| 55 | N2 ; Process second node if first is non-numeric or ^UTILITY("%ER" for MSM
|
|---|
| 56 | S ZIBX2="",ZIBA1=""""_ZIBA_""""
|
|---|
| 57 | F ZIBI=1:1 S ZIBRM=1,ZIBX2=$O(@(ZIBGR_""""_ZIBX1_""","""_ZIBX2_""")")) D D:ZIBRM RM Q:ZIBX2=""
|
|---|
| 58 | .I ZIBOS?1"MSM".E,ZIBX1="%ER",($P($H,",")-ZIBX2)<7 S ZIBRM=0 Q
|
|---|
| 59 | .I ZIBX2]"" S ZIBA=ZIBA1_","""_ZIBX2_"""",ZIBJ=ZIBX2
|
|---|
| 60 | KILL ZIBRM
|
|---|
| 61 | Q
|
|---|
| 62 | ;
|
|---|
| 63 | RM ; Remove dangling ^UTILITY node.
|
|---|
| 64 | ; If not in active JOB table '$D(ZIBJT(ZIBJ))
|
|---|
| 65 | ; Or if an active JOB and not this UCI $D(ZIBJT(ZIBJ) & ZIBJT(ZIBJ)'=$Z(0)
|
|---|
| 66 | ; Or if an active JOB and this UCI, but the same $J as this JOB.
|
|---|
| 67 | I $D(ZIBJT(ZIBJ)),ZIBJT(ZIBJ)=$ZU(0),$J'=ZIBJ G RMQ
|
|---|
| 68 | KILL @(ZIBGR_ZIBA_")") ; Remove dangling ^ZUT or ^UTILITY node.
|
|---|
| 69 | RMQ ;
|
|---|
| 70 | Q
|
|---|
| 71 | ;
|
|---|
| 72 | OUT ;
|
|---|
| 73 | KILL ZIBOS,ZIBA,ZIBA1,ZIBX1,ZIBX2,ZIBST,ZIBJT,ZIBJM,ZIBJI,ZIBJ,ZIBQ,ZIBGR,ZIBSTA,ZIBMXJ,ZIBPT,ZIBK
|
|---|
| 74 | I $ZV?1"MSM".E V 44:$J:$ZB($V(44,$J,2),#FFFE,1):2
|
|---|
| 75 | Q
|
|---|
| 76 | ;
|
|---|
