ZISPL2 ;SF/RWF - SPOOLER CLEAN-UP ;12/03/97 14:57
;;8.0;KERNEL;**23,36,69**;Jul 10, 1995
1 N DA,DIC,DIK,ZIS,ZISPL
K ^XMB(3.51,"AM") ;Clear X-ref first
S DIK="^XMB(3.51," D IXALL^DIK ;Re-Index
S ZISPL=$G(^XTV(8989.3,1,"SPL"),"1^1^999"),ZISDT=$$FMADD^XLFDT(DT,"-"_$P(ZISPL,"^",3))
F DA=0:0 S DA=$O(^XMB(3.51,DA)) Q:DA'>0 S ZIS=^XMB(3.51,DA,0) I "rpm"[$P(ZIS,"^",3),ZISDT>$S($P(ZIS,"^",6)]"":$P(ZIS,"^",6),$P(ZIS,"^",4)]"":$P(ZIS,"^",4),1:ZISDT) D DELETE
F DA=0:0 S DA=$O(^XMB(3.51,DA)) Q:DA'>0 S ZIS=^XMB(3.51,DA,0) I "ao"[$P(ZIS,"^",3),ZISDT>$S($P(ZIS,"^",6)]"":$P(ZIS,"^",6),$P(ZIS,"^",4)]"":$P(ZIS,"^",4),1:ZISDT) D CLOSE
F DA=0:0 S DA=$O(^XMBS(3.519,DA)) Q:DA'>0 I '$D(^XMB(3.51,"AM",DA)) D DSD^ZISPL(DA) ;Remove Spool data w/o Spool entry
Q
DELETE ;REMOVE SPOOL DOC.
D DSD^ZISPL($P(ZIS,U,10)) ;Delete Spool Data entry
S DIK="^XMB(3.51," D ^DIK ;Delete entry
Q
CLOSE ;Close a SPOOL DOC that has been open too long.
I $$NEWERR^%ZTER N $ESTACK,$ETRAP S $ETRAP=""
S X="ET^ZISPL2",@^%ZOSF("TRAP")
S %ZFN=$P(ZIS,"^",2),IO=%ZFN,IO("SPOOL")=DA
D SPL3^%ZIS4 I %ZFN="" D DELETE Q
X "N DA,ZIS D CLOSE^%ZIS4" Q
ET ;TRAP ERROR.
D DELETE Q
DQP Q:'$D(^XMB(3.51,ZISDA,2,ZISDA2,0))!('$D(ZISPLC)) ;Dequeue print
S ZISPL0=^XMB(3.51,ZISDA,0),FF="|TOP|",XS=$P(ZISPL0,U,10) Q:XS'>0
U IO F ZISCNT=ZISPLC:-1:1 S PG=1 D OUT S $P(^(0),U,6)=$P(^XMB(3.51,ZISDA,2,ZISDA2,0),U,6)+1
W:$Y>3 @IOF D NOW^%DTC S $P(^XMB(3.51,ZISDA,0),"^",3)="p",$P(^(0),"^",7)=%,$P(^XMB(3.51,ZISDA,2,ZISDA2,0),U,3,5)="^^"_%
D ^%ZISC G EXIT^ZISPL
;
OUT ;
F I=0:0 S I=$O(^XMBS(3.519,XS,2,I)) Q:I'>0 S X=^(I,0),Y=(X=FF) W:Y @IOF W:'Y X,! I Y S PG=PG+1,$P(^XMB(3.51,ZISDA,2,ZISDA2,0),"^",3,4)=PG_"^"_I
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HZISPL2 1712 printed Nov 22, 2024@17:25:19 Page 2
ZISPL2 ;SF/RWF - SPOOLER CLEAN-UP ;12/03/97 14:57
+1 ;;8.0;KERNEL;**23,36,69**;Jul 10, 1995
1 NEW DA,DIC,DIK,ZIS,ZISPL
+1 ;Clear X-ref first
KILL ^XMB(3.51,"AM")
+2 ;Re-Index
SET DIK="^XMB(3.51,"
DO IXALL^DIK
+3 SET ZISPL=$GET(^XTV(8989.3,1,"SPL"),"1^1^999")
SET ZISDT=$$FMADD^XLFDT(DT,"-"_$PIECE(ZISPL,"^",3))
+4 FOR DA=0:0
SET DA=$ORDER(^XMB(3.51,DA))
if DA'>0
QUIT
SET ZIS=^XMB(3.51,DA,0)
IF "rpm"[$PIECE(ZIS,"^",3)
IF ZISDT>$SELECT($PIECE(ZIS,"^",6)]"":$PIECE(ZIS,"^",6),$PIECE(ZIS,"^",4)]"":$PIECE(ZIS,"^",4),1:ZISDT)
DO DELETE
+5 FOR DA=0:0
SET DA=$ORDER(^XMB(3.51,DA))
if DA'>0
QUIT
SET ZIS=^XMB(3.51,DA,0)
IF "ao"[$PIECE(ZIS,"^",3)
IF ZISDT>$SELECT($PIECE(ZIS,"^",6)]"":$PIECE(ZIS,"^",6),$PIECE(ZIS,"^",4)]"":$PIECE(ZIS,"^",4),1:ZISDT)
DO CLOSE
+6 ;Remove Spool data w/o Spool entry
FOR DA=0:0
SET DA=$ORDER(^XMBS(3.519,DA))
if DA'>0
QUIT
IF '$DATA(^XMB(3.51,"AM",DA))
DO DSD^ZISPL(DA)
+7 QUIT
DELETE ;REMOVE SPOOL DOC.
+1 ;Delete Spool Data entry
DO DSD^ZISPL($PIECE(ZIS,U,10))
+2 ;Delete entry
SET DIK="^XMB(3.51,"
DO ^DIK
+3 QUIT
CLOSE ;Close a SPOOL DOC that has been open too long.
+1 IF $$NEWERR^%ZTER
NEW $ESTACK,$ETRAP
SET $ETRAP=""
+2 SET X="ET^ZISPL2"
SET @^%ZOSF("TRAP")
+3 SET %ZFN=$PIECE(ZIS,"^",2)
SET IO=%ZFN
SET IO("SPOOL")=DA
+4 DO SPL3^%ZIS4
IF %ZFN=""
DO DELETE
QUIT
+5 XECUTE "N DA,ZIS D CLOSE^%ZIS4"
QUIT
ET ;TRAP ERROR.
+1 DO DELETE
QUIT
DQP ;Dequeue print
if '$DATA(^XMB(3.51,ZISDA,2,ZISDA2,0))!('$DATA(ZISPLC))
QUIT
+1 SET ZISPL0=^XMB(3.51,ZISDA,0)
SET FF="|TOP|"
SET XS=$PIECE(ZISPL0,U,10)
if XS'>0
QUIT
+2 USE IO
FOR ZISCNT=ZISPLC:-1:1
SET PG=1
DO OUT
SET $PIECE(^(0),U,6)=$PIECE(^XMB(3.51,ZISDA,2,ZISDA2,0),U,6)+1
+3 if $Y>3
WRITE @IOF
DO NOW^%DTC
SET $PIECE(^XMB(3.51,ZISDA,0),"^",3)="p"
SET $PIECE(^(0),"^",7)=%
SET $PIECE(^XMB(3.51,ZISDA,2,ZISDA2,0),U,3,5)="^^"_%
+4 DO ^%ZISC
GOTO EXIT^ZISPL
+5 ;
OUT ;
+1 FOR I=0:0
SET I=$ORDER(^XMBS(3.519,XS,2,I))
if I'>0
QUIT
SET X=^(I,0)
SET Y=(X=FF)
if Y
WRITE @IOF
if 'Y
WRITE X,!
IF Y
SET PG=PG+1
SET $PIECE(^XMB(3.51,ZISDA,2,ZISDA2,0),"^",3,4)=PG_"^"_I
+2 QUIT
