- 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 Mar 13, 2025@21:20:05 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
