- %ZIBCLU0 ; IHS/ADC/GTH - GENERAL PURPOSE CLEAN UP UTILITY GLOBALS ; [ 02/07/97 3:02 PM ]
- ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
- EN ;
- Q:'($ZV?1"MSM".E!($ZV?1"DSM".E)) ; Only works for MSM or DSM.
- S ZIBOS=$ZV ; Set operating system.
- D @$S(ZIBOS?1"DSM".E:"DSM",1:"MSM") ; Active JOB lookup per operating system.
- D XUT ; Cleanup the ^XUTL global.
- F ZIBGR="^ZUT(","^UTILITY(" D GO ; Check the ^ZUT and ^UTILITY globals for nodes to be removed.
- D OUT ; KILL off variables and exit gracefully.
- Q
- ;
- MSM ; MSM specific look up of active JOBs.
- S $ZT="MER^%ZIBCLU0"
- V 44:$J:$ZB($V(44,$J,2),1,7):2
- S ZIBST=$V(44),ZIBSTA=$V(ZIBST+8,-3,2)+ZIBST,ZIBMXJ=$V($V(ZIBST+284),-3,4),ZIBPT=$V(3*4+ZIBSTA)
- ; Build active JOB table (ZIBJT).
- F ZIBJ=1:1:ZIBMXJ S:$V(ZIBJ*4+ZIBPT) ZIBJT(ZIBJ)=$ZU(($V(2,ZIBJ,2)#32),($V(2,ZIBJ,2)\32))
- Q
- ;
- MER ;EP - MSM error trap.
- V 44:$J:$ZB($V(44,$J,2),#FFFE,1):2
- ZQ
- ;
- DSM ; DSM specific look up of active JOBs.
- S ZIBST=$V(44),ZIBSJT=$V(ZIBST+4)
- ; Build active JOB table (ZIBJT).
- 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))
- S ZIBJT($J)=$ZU(0) ; Put this JOB and UCI in the JOB table.
- KILL ZIBSJT
- Q
- ;
- XUT ; Clenaup ^XUTL in MGR separate from other UCIs.
- I $ZU(0)?1"MGR".E D
- . S ZIBJ=""
- . F S ZIBJ=$O(^XUTL("XQ",ZIBJ)) Q:ZIBJ="" KILL:'$D(ZIBJT(ZIBJ)) ^(ZIBJ)
- E D
- .S ZIBJ=""
- .S ZIBK=1 ; Set KILL flag ON - Set OFF if other JOBs active in this UCI
- .F S ZIBJ=$O(ZIBJT(ZIBJ)) Q:ZIBJ="" S:ZIBJ'=$J&(ZIBJT(ZIBJ)=$ZU(0)) ZIBK=0
- .I ZIBK S ZIBX="" F S ZIBX=$O(^XUTL(ZIBX)) Q:ZIBX="" KILL ^(ZIBX)
- Q
- ;
- GO ; $O down ^ZUT or ^UTILITY looking for (jobnbr OR (namespace,jobnbr
- S ZIBX1=""
- F S (ZIBA,ZIBJ,ZIBX1)=$O(@(ZIBGR_""""_ZIBX1_""")")) Q:ZIBX1="" D @$S(ZIBX1?1N.N:"N1",1:"N2")
- GOQ ;
- Q
- ;
- N1 ; Check first subscript value and remove if its a dangling node.
- I ZIBOS?1"MSM".E,ZIBX1="%ER" D N2 G N1Q
- D RM
- N1Q ;
- Q
- ;
- N2 ; Process second node if first is non-numeric or ^UTILITY("%ER" for MSM
- S ZIBX2="",ZIBA1=""""_ZIBA_""""
- F ZIBI=1:1 S ZIBRM=1,ZIBX2=$O(@(ZIBGR_""""_ZIBX1_""","""_ZIBX2_""")")) D D:ZIBRM RM Q:ZIBX2=""
- .I ZIBOS?1"MSM".E,ZIBX1="%ER",($P($H,",")-ZIBX2)<7 S ZIBRM=0 Q
- .I ZIBX2]"" S ZIBA=ZIBA1_","""_ZIBX2_"""",ZIBJ=ZIBX2
- KILL ZIBRM
- Q
- ;
- RM ; Remove dangling ^UTILITY node.
- ; If not in active JOB table '$D(ZIBJT(ZIBJ))
- ; Or if an active JOB and not this UCI $D(ZIBJT(ZIBJ) & ZIBJT(ZIBJ)'=$Z(0)
- ; Or if an active JOB and this UCI, but the same $J as this JOB.
- I $D(ZIBJT(ZIBJ)),ZIBJT(ZIBJ)=$ZU(0),$J'=ZIBJ G RMQ
- KILL @(ZIBGR_ZIBA_")") ; Remove dangling ^ZUT or ^UTILITY node.
- RMQ ;
- Q
- ;
- OUT ;
- KILL ZIBOS,ZIBA,ZIBA1,ZIBX1,ZIBX2,ZIBST,ZIBJT,ZIBJM,ZIBJI,ZIBJ,ZIBQ,ZIBGR,ZIBSTA,ZIBMXJ,ZIBPT,ZIBK
- I $ZV?1"MSM".E V 44:$J:$ZB($V(44,$J,2),#FFFE,1):2
- Q
- ;
- %ZIBCLU0 ; IHS/ADC/GTH - GENERAL PURPOSE CLEAN UP UTILITY GLOBALS ; [ 02/07/97 3:02 PM ]
- +1 ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
- EN ;
- +1 ; Only works for MSM or DSM.
- IF '($ZV?1"MSM".E!($ZV?1"DSM".E))
- QUIT
- +2 ; Set operating system.
- SET ZIBOS=$ZV
- +3 ; Active JOB lookup per operating system.
- DO @$SELECT(ZIBOS?1"DSM".E:"DSM",1:"MSM")
- +4 ; Cleanup the ^XUTL global.
- DO XUT
- +5 ; Check the ^ZUT and ^UTILITY globals for nodes to be removed.
- FOR ZIBGR="^ZUT(","^UTILITY("
- DO GO
- +6 ; KILL off variables and exit gracefully.
- DO OUT
- +7 QUIT
- +8 ;
- MSM ; MSM specific look up of active JOBs.
- +1 SET $ZT="MER^%ZIBCLU0"
- +2 VIEW 44:$JOB:$ZB($VIEW(44,$JOB,2),1,7):2
- +3 SET ZIBST=$VIEW(44)
- SET ZIBSTA=$VIEW(ZIBST+8,-3,2)+ZIBST
- SET ZIBMXJ=$VIEW($VIEW(ZIBST+284),-3,4)
- SET ZIBPT=$VIEW(3*4+ZIBSTA)
- +4 ; Build active JOB table (ZIBJT).
- +5 FOR ZIBJ=1:1:ZIBMXJ
- IF $VIEW(ZIBJ*4+ZIBPT)
- SET ZIBJT(ZIBJ)=$ZU(($VIEW(2,ZIBJ,2)#32),($VIEW(2,ZIBJ,2)\32))
- +6 QUIT
- +7 ;
- MER ;EP - MSM error trap.
- +1 VIEW 44:$JOB:$ZB($VIEW(44,$JOB,2),#FFFE,1):2
- +2
- *** ERROR ***
- +3 ;
- DSM ; DSM specific look up of active JOBs.
- +1 SET ZIBST=$VIEW(44)
- SET ZIBSJT=$VIEW(ZIBST+4)
- +2 ; Build active JOB table (ZIBJT).
- +3 FOR ZIBI=ZIBSJT+2:2:ZIBSJT+126
- IF $VIEW(ZIBI+1)
- IF $VIEW(ZIBI+1)'=244
- SET ZIBJ=ZIBI-ZIBSJT\2
- IF ZIBJ]""
- SET ZIBJT(ZIBJ)=$ZU(($VIEW(149,ZIBJ)#32),($VIEW(149,ZIBJ)\32))
- +4 ; Put this JOB and UCI in the JOB table.
- SET ZIBJT($JOB)=$ZU(0)
- +5 KILL ZIBSJT
- +6 QUIT
- +7 ;
- XUT ; Clenaup ^XUTL in MGR separate from other UCIs.
- +1 IF $ZU(0)?1"MGR".E
- Begin DoDot:1
- +2 SET ZIBJ=""
- +3 FOR
- SET ZIBJ=$ORDER(^XUTL("XQ",ZIBJ))
- IF ZIBJ=""
- QUIT
- IF '$DATA(ZIBJT(ZIBJ))
- KILL ^(ZIBJ)
- End DoDot:1
- +4 IF '$TEST
- Begin DoDot:1
- +5 SET ZIBJ=""
- +6 ; Set KILL flag ON - Set OFF if other JOBs active in this UCI
- SET ZIBK=1
- +7 FOR
- SET ZIBJ=$ORDER(ZIBJT(ZIBJ))
- IF ZIBJ=""
- QUIT
- IF ZIBJ'=$JOB&(ZIBJT(ZIBJ)=$ZU(0))
- SET ZIBK=0
- +8 IF ZIBK
- SET ZIBX=""
- FOR
- SET ZIBX=$ORDER(^XUTL(ZIBX))
- IF ZIBX=""
- QUIT
- KILL ^(ZIBX)
- End DoDot:1
- +9 QUIT
- +10 ;
- GO ; $O down ^ZUT or ^UTILITY looking for (jobnbr OR (namespace,jobnbr
- +1 SET ZIBX1=""
- +2 FOR
- SET (ZIBA,ZIBJ,ZIBX1)=$ORDER(@(ZIBGR_""""_ZIBX1_""")"))
- IF ZIBX1=""
- QUIT
- DO @$SELECT(ZIBX1?1N.N:"N1",1:"N2")
- GOQ ;
- +1 QUIT
- +2 ;
- N1 ; Check first subscript value and remove if its a dangling node.
- +1 IF ZIBOS?1"MSM".E
- IF ZIBX1="%ER"
- DO N2
- GOTO N1Q
- +2 DO RM
- N1Q ;
- +1 QUIT
- +2 ;
- N2 ; Process second node if first is non-numeric or ^UTILITY("%ER" for MSM
- +1 SET ZIBX2=""
- SET ZIBA1=""""_ZIBA_""""
- +2 FOR ZIBI=1:1
- SET ZIBRM=1
- SET ZIBX2=$ORDER(@(ZIBGR_""""_ZIBX1_""","""_ZIBX2_""")"))
- Begin DoDot:1
- +3 IF ZIBOS?1"MSM".E
- IF ZIBX1="%ER"
- IF ($PIECE($HOROLOG,",")-ZIBX2)<7
- SET ZIBRM=0
- QUIT
- +4 IF ZIBX2]""
- SET ZIBA=ZIBA1_","""_ZIBX2_""""
- SET ZIBJ=ZIBX2
- End DoDot:1
- IF ZIBRM
- DO RM
- IF ZIBX2=""
- QUIT
- +5 KILL ZIBRM
- +6 QUIT
- +7 ;
- RM ; Remove dangling ^UTILITY node.
- +1 ; If not in active JOB table '$D(ZIBJT(ZIBJ))
- +2 ; Or if an active JOB and not this UCI $D(ZIBJT(ZIBJ) & ZIBJT(ZIBJ)'=$Z(0)
- +3 ; Or if an active JOB and this UCI, but the same $J as this JOB.
- +4 IF $DATA(ZIBJT(ZIBJ))
- IF ZIBJT(ZIBJ)=$ZU(0)
- IF $JOB'=ZIBJ
- GOTO RMQ
- +5 ; Remove dangling ^ZUT or ^UTILITY node.
- KILL @(ZIBGR_ZIBA_")")
- RMQ ;
- +1 QUIT
- +2 ;
- OUT ;
- +1 KILL ZIBOS,ZIBA,ZIBA1,ZIBX1,ZIBX2,ZIBST,ZIBJT,ZIBJM,ZIBJI,ZIBJ,ZIBQ,ZIBGR,ZIBSTA,ZIBMXJ,ZIBPT,ZIBK
- +2 IF $ZV?1"MSM".E
- VIEW 44:$JOB:$ZB($VIEW(44,$JOB,2),#FFFE,1):2
- +3 QUIT
- +4 ;
