- ZISPL1 ;SF/RWF - %ZIS UTILITIES FOR SPOOLING ;11/20/97 08:53
- ;;8.0;KERNEL;**23,36,69**;Jul 10, 1995
- ;This is general code for managment of the spooler file from %ZIS.
- Q
- ;
- FILE ;Called by %ZIS4 to setup spool data file.
- S %ZDA=$S($D(IO("SPOOL")):IO("SPOOL"),$D(^XUTL("XQ",$J,"SPOOL")):^("SPOOL"),1:0) Q:%ZDA'>0
- I '$D(ZISPLAD),$D(^XUTL("XQ",$J,"ADSPL")) S ZISPLAD=^("ADSPL")
- K ^XUTL("XQ",$J,"SPOOL"),^("ADSPL"),IO("SPOOL") S %ZS=$S($D(^XMB(3.51,%ZDA,0)):^(0),1:"") I %ZS']"" S %ZDA=-1 Q
- I '$D(ZTSK) S ZTRTN="DQC^ZISPL1",ZTDESC="Background Spool Filer",ZTDTH=$H,ZTIO="",ZTSAVE("%ZDA")="" S:$D(ZISPLAD) ZTSAVE("ZISPLAD")="",ZTSAVE("%ZS")="" D ^%ZTLOAD K ZISPLAD,ZTSK S %ZDA=-1 Q
- N X,Y K DD,DO S X=%ZDA,DIC="^XMBS(3.519,",DIC(0)="LZ",DLAYGO=3.519 D FILE^DICN S XS=+Y
- K DD,DO,DLAYGO
- S $P(^XMB(3.51,%ZDA,0),"^",3)="a",$P(^(0),"^",6)=DT,$P(^(0),"^",10)=XS,^XMB(3.51,"AM",XS,%ZDA)="" Q
- ;
- CLOSE S ^XMBS(3.519,XS,2,0)="^^"_%_"^"_%,$P(^XMB(3.51,%ZDA,0),"^",2,3)="^r",$P(^(0),"^",9)=%
- I $D(ZISPLAD) F %=0:0 S %=$O(^%ZIS(1,+ZISPLAD,"SPL",%)) Q:%'>0 D
- .I $D(^%ZIS(1,+ZISPLAD,"SPL",%,0)) S %X=^(0) D
- ..S ZISPLC=$S($P(%X,"^",2)]"":+$P(%X,"^",2),1:1),%X=$P(%X,"^")
- ..I $D(^%ZIS(1,+%X,0)) K ZISDA2 S ZISPLDV=$P(^(0),"^"),DIE="^XMB(3.51,",DR="[XU-ZISPL1]",(ZISDA,DA)=%ZDA D ADSPL
- K ^XMB(3.51,"C",%ZFN),XMZ,XMDUZ,%ZDA,%ZFN,% Q
- ;
- DQC ;DQ the move from spool to mail message.
- S IO("SPOOL")=%ZDA D CLOSE^%ZIS4 Q
- ;
- ADSPL N %,ZTSK D ^DIE Q:'$D(ZISDA2)
- S %X="^"_ZISPLC_"^^^^^"_ZISPLDV_";"_$P(%ZS,"^",8)_"^"_$H
- ;
- QDSPL S ZISPLC=$P(%X,"^",2),ZTIO=$P(%X,"^",7),ZTDTH=$P(%X,"^",8),ZTRTN="DQP^ZISPL2",ZTDESC="Auto despool document"
- I ZTIO]"",ZTDTH]"",ZISPLC S ZISDA=%ZDA,ZTSAVE("ZISDA")="",ZTSAVE("ZISDA2")="",ZTSAVE("ZISPLC")="" D ^%ZTLOAD K ZTSK
- Q
- ;
- NEWDOC ;Called by %ZIS4 to get or setup a spool document.
- N DIC,X,Y I $S($D(^VA(200,DUZ,"SPL")):$E(^("SPL"),1),1:"N")'["y" W:'$D(IOP) !?5,"You aren't an authorized SPOOLER user." Q
- D LIMITS
- I '$D(IOP),%Z1'>%Z2!($P(%Z1,"^",2)'>%Z3) D MSG1 Q
- R S %Y=$S($D(IO("DOC")):IO("DOC"),$G(%ZISMY)]"":$P(%ZISMY,";",1),1:$P(%Y,";",1)) K %Z1,%Z2,%Z3
- S DIC=3.51,U="^",DIC("DR")="",DIC("S")="I '$P(^(0),U,10)",DIC("W")="W "" Status: "",$P(^(0),U,3),"" Lines: "",$P(^(0),U,9)"
- I %IS'[0,$D(^%ZIS(1,%ZISIOS,1)),$P(^(1),"^",9) D GENDOC G R1
- I $D(IOP) S X=%Y,DIC(0)="XMLZ"
- E S DIC(0)="AEQMZL" S:%Y?1A.ANP DIC("B")=%Y
- S DLAYGO=3,%ZY=-1 D ^DIC K DLAYGO Q:Y<0
- R1 S %ZY=Y,%ZY(0)=Y(0),ZISIOST="P-OTHER",$P(%Z91,"^",2)="#" G:'$P(Y,"^",3) ND3
- S %=$$NOW^XLFDT
- S ^XMB(3.51,+Y,0)=$P(^XMB(3.51,+Y,0),"^",1)_"^^o^"_%_U_DUZ_"^^^"_+%Z91_";"_$P(%Z91,"^",3),^XMB(3.51,"AOK",+Y,DUZ)="",^XMB(3.51,"ADUZ",DUZ,+Y)=""
- ND3 S %=$P(^XMB(3.51,+Y,0),"^",8),$P(%Z91,"^")=+%,$P(%Z91,"^",3)=$P(%,";",2)
- Q
- LIMITS S %Z1=$G(^XTV(8989.3,1,"SPL")),(%Z2,%Z3)=0
- ;The next line only counts doc names w/ data
- ;F %=0:0 S %=$O(^XMB(3.51,"ADUZ",DUZ,%)) Q:%'>0 S %Z4=$S($D(^XMB(3.51,%,0)):^(0),1:""),%Z2=%Z2+$P(%Z4,"^",9),%Z3=$P(%Z4,"^",10)>1+%Z3
- ;This line counts all doc names.
- F %=0:0 S %=$O(^XMB(3.51,"ADUZ",DUZ,%)) Q:%'>0 S %Z4=$G(^XMB(3.51,%,0)),%Z2=%Z2+$P(%Z4,"^",9),%Z3=%Z3+1
- Q
- GENDOC ;Auto generate document name.
- D FLST S %ZY=$E($P(^%ZIS(1,%ZISIOS,0),"^"),1,25)
- I %ZY["|DT|" S %ZY=$P(%ZY,"|DT|")_$$HTE^XLFDT($H,"2D")_$P(%ZY,"|DT|",2)
- G1 S ZISPLST=ZISPLST+1,X=%ZY_"_"_+ZISPLST G G1:$D(^XMB(3.51,+ZISPLST,0)),G1:$O(^XMB(3.51,"B",X,0))>0
- S DIC=3.51,DIC(0)="XMLZ",DINUM=+ZISPLST,DLAYGO=3
- D ^DIC K DLAYGO I Y'>0 G G1
- Q
- ;
- MSG1 W !,*7,"You have too many documents or lines, Please delete some documents" Q
- ;
- FLST S ZISPLST=$P($G(^XMB(3.51,0)),"^",3)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HZISPL1 3630 printed Mar 13, 2025@21:20:04 Page 2
- ZISPL1 ;SF/RWF - %ZIS UTILITIES FOR SPOOLING ;11/20/97 08:53
- +1 ;;8.0;KERNEL;**23,36,69**;Jul 10, 1995
- +2 ;This is general code for managment of the spooler file from %ZIS.
- +3 QUIT
- +4 ;
- FILE ;Called by %ZIS4 to setup spool data file.
- +1 SET %ZDA=$SELECT($DATA(IO("SPOOL")):IO("SPOOL"),$DATA(^XUTL("XQ",$JOB,"SPOOL")):^("SPOOL"),1:0)
- if %ZDA'>0
- QUIT
- +2 IF '$DATA(ZISPLAD)
- IF $DATA(^XUTL("XQ",$JOB,"ADSPL"))
- SET ZISPLAD=^("ADSPL")
- +3 KILL ^XUTL("XQ",$JOB,"SPOOL"),^("ADSPL"),IO("SPOOL")
- SET %ZS=$SELECT($DATA(^XMB(3.51,%ZDA,0)):^(0),1:"")
- IF %ZS']""
- SET %ZDA=-1
- QUIT
- +4 IF '$DATA(ZTSK)
- SET ZTRTN="DQC^ZISPL1"
- SET ZTDESC="Background Spool Filer"
- SET ZTDTH=$HOROLOG
- SET ZTIO=""
- SET ZTSAVE("%ZDA")=""
- if $DATA(ZISPLAD)
- SET ZTSAVE("ZISPLAD")=""
- SET ZTSAVE("%ZS")=""
- DO ^%ZTLOAD
- KILL ZISPLAD,ZTSK
- SET %ZDA=-1
- QUIT
- +5 NEW X,Y
- KILL DD,DO
- SET X=%ZDA
- SET DIC="^XMBS(3.519,"
- SET DIC(0)="LZ"
- SET DLAYGO=3.519
- DO FILE^DICN
- SET XS=+Y
- +6 KILL DD,DO,DLAYGO
- +7 SET $PIECE(^XMB(3.51,%ZDA,0),"^",3)="a"
- SET $PIECE(^(0),"^",6)=DT
- SET $PIECE(^(0),"^",10)=XS
- SET ^XMB(3.51,"AM",XS,%ZDA)=""
- QUIT
- +8 ;
- CLOSE SET ^XMBS(3.519,XS,2,0)="^^"_%_"^"_%
- SET $PIECE(^XMB(3.51,%ZDA,0),"^",2,3)="^r"
- SET $PIECE(^(0),"^",9)=%
- +1 IF $DATA(ZISPLAD)
- FOR %=0:0
- SET %=$ORDER(^%ZIS(1,+ZISPLAD,"SPL",%))
- if %'>0
- QUIT
- Begin DoDot:1
- +2 IF $DATA(^%ZIS(1,+ZISPLAD,"SPL",%,0))
- SET %X=^(0)
- Begin DoDot:2
- +3 SET ZISPLC=$SELECT($PIECE(%X,"^",2)]"":+$PIECE(%X,"^",2),1:1)
- SET %X=$PIECE(%X,"^")
- +4 IF $DATA(^%ZIS(1,+%X,0))
- KILL ZISDA2
- SET ZISPLDV=$PIECE(^(0),"^")
- SET DIE="^XMB(3.51,"
- SET DR="[XU-ZISPL1]"
- SET (ZISDA,DA)=%ZDA
- DO ADSPL
- End DoDot:2
- End DoDot:1
- +5 KILL ^XMB(3.51,"C",%ZFN),XMZ,XMDUZ,%ZDA,%ZFN,%
- QUIT
- +6 ;
- DQC ;DQ the move from spool to mail message.
- +1 SET IO("SPOOL")=%ZDA
- DO CLOSE^%ZIS4
- QUIT
- +2 ;
- ADSPL NEW %,ZTSK
- DO ^DIE
- if '$DATA(ZISDA2)
- QUIT
- +1 SET %X="^"_ZISPLC_"^^^^^"_ZISPLDV_";"_$PIECE(%ZS,"^",8)_"^"_$HOROLOG
- +2 ;
- QDSPL SET ZISPLC=$PIECE(%X,"^",2)
- SET ZTIO=$PIECE(%X,"^",7)
- SET ZTDTH=$PIECE(%X,"^",8)
- SET ZTRTN="DQP^ZISPL2"
- SET ZTDESC="Auto despool document"
- +1 IF ZTIO]""
- IF ZTDTH]""
- IF ZISPLC
- SET ZISDA=%ZDA
- SET ZTSAVE("ZISDA")=""
- SET ZTSAVE("ZISDA2")=""
- SET ZTSAVE("ZISPLC")=""
- DO ^%ZTLOAD
- KILL ZTSK
- +2 QUIT
- +3 ;
- NEWDOC ;Called by %ZIS4 to get or setup a spool document.
- +1 NEW DIC,X,Y
- IF $SELECT($DATA(^VA(200,DUZ,"SPL")):$EXTRACT(^("SPL"),1),1:"N")'["y"
- if '$DATA(IOP)
- WRITE !?5,"You aren't an authorized SPOOLER user."
- QUIT
- +2 DO LIMITS
- +3 IF '$DATA(IOP)
- IF %Z1'>%Z2!($PIECE(%Z1,"^",2)'>%Z3)
- DO MSG1
- QUIT
- R SET %Y=$SELECT($DATA(IO("DOC")):IO("DOC"),$GET(%ZISMY)]"":$PIECE(%ZISMY,";",1),1:$PIECE(%Y,";",1))
- KILL %Z1,%Z2,%Z3
- +1 SET DIC=3.51
- SET U="^"
- SET DIC("DR")=""
- SET DIC("S")="I '$P(^(0),U,10)"
- SET DIC("W")="W "" Status: "",$P(^(0),U,3),"" Lines: "",$P(^(0),U,9)"
- +2 IF %IS'[0
- IF $DATA(^%ZIS(1,%ZISIOS,1))
- IF $PIECE(^(1),"^",9)
- DO GENDOC
- GOTO R1
- +3 IF $DATA(IOP)
- SET X=%Y
- SET DIC(0)="XMLZ"
- +4 IF '$TEST
- SET DIC(0)="AEQMZL"
- if %Y?1A.ANP
- SET DIC("B")=%Y
- +5 SET DLAYGO=3
- SET %ZY=-1
- DO ^DIC
- KILL DLAYGO
- if Y<0
- QUIT
- R1 SET %ZY=Y
- SET %ZY(0)=Y(0)
- SET ZISIOST="P-OTHER"
- SET $PIECE(%Z91,"^",2)="#"
- if '$PIECE(Y,"^",3)
- GOTO ND3
- +1 SET %=$$NOW^XLFDT
- +2 SET ^XMB(3.51,+Y,0)=$PIECE(^XMB(3.51,+Y,0),"^",1)_"^^o^"_%_U_DUZ_"^^^"_+%Z91_";"_$PIECE(%Z91,"^",3)
- SET ^XMB(3.51,"AOK",+Y,DUZ)=""
- SET ^XMB(3.51,"ADUZ",DUZ,+Y)=""
- ND3 SET %=$PIECE(^XMB(3.51,+Y,0),"^",8)
- SET $PIECE(%Z91,"^")=+%
- SET $PIECE(%Z91,"^",3)=$PIECE(%,";",2)
- +1 QUIT
- LIMITS SET %Z1=$GET(^XTV(8989.3,1,"SPL"))
- SET (%Z2,%Z3)=0
- +1 ;The next line only counts doc names w/ data
- +2 ;F %=0:0 S %=$O(^XMB(3.51,"ADUZ",DUZ,%)) Q:%'>0 S %Z4=$S($D(^XMB(3.51,%,0)):^(0),1:""),%Z2=%Z2+$P(%Z4,"^",9),%Z3=$P(%Z4,"^",10)>1+%Z3
- +3 ;This line counts all doc names.
- +4 FOR %=0:0
- SET %=$ORDER(^XMB(3.51,"ADUZ",DUZ,%))
- if %'>0
- QUIT
- SET %Z4=$GET(^XMB(3.51,%,0))
- SET %Z2=%Z2+$PIECE(%Z4,"^",9)
- SET %Z3=%Z3+1
- +5 QUIT
- GENDOC ;Auto generate document name.
- +1 DO FLST
- SET %ZY=$EXTRACT($PIECE(^%ZIS(1,%ZISIOS,0),"^"),1,25)
- +2 IF %ZY["|DT|"
- SET %ZY=$PIECE(%ZY,"|DT|")_$$HTE^XLFDT($HOROLOG,"2D")_$PIECE(%ZY,"|DT|",2)
- G1 SET ZISPLST=ZISPLST+1
- SET X=%ZY_"_"_+ZISPLST
- if $DATA(^XMB(3.51,+ZISPLST,0))
- GOTO G1
- if $ORDER(^XMB(3.51,"B",X,0))>0
- GOTO G1
- +1 SET DIC=3.51
- SET DIC(0)="XMLZ"
- SET DINUM=+ZISPLST
- SET DLAYGO=3
- +2 DO ^DIC
- KILL DLAYGO
- IF Y'>0
- GOTO G1
- +3 QUIT
- +4 ;
- MSG1 WRITE !,*7,"You have too many documents or lines, Please delete some documents"
- QUIT
- +1 ;
- FLST SET ZISPLST=$PIECE($GET(^XMB(3.51,0)),"^",3)
- +1 QUIT
