ZISPL ;SF/RWF - UTILITIES FOR SPOOLING ;04/07/98 16:16 [ 04/02/2003 8:29 AM ]
;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
;;8.0;KERNEL;**23,69**;Jul 10, 1995
;This is the general code for managment of the spooler file.
DELETE ;delete a document from the file.
A S DIC("A")="Delete which SPOOL DOCUMENT: " D GETDOC G:Y<0 EXIT
I '$P(ZISPL0,U,7) W !,*7,"This Document hasn't been printed. Are you sure??"
S DIR(0)="S^n:NO;y:YES;c:CLEAR",DIR("A")="...OK TO DELETE",DIR("B")="NO" D ^DIR K DIR G:$D(DIRUT)!("yc"'[Y) EXIT
S ZISY=Y D DSD($P(ZISPL0,U,10)) ;delete data
I ZISY["c" S X=^XMB(3.51,ZISDA,0),^(0)=$P(X,"^",1)_"^^^^"_DUZ_"^^^"_$P(X,"^",8) K ^XMB(3.51,ZISDA,2) W " ... DOCUMENT CLEARED!!" G EXIT
;
D DSDOC(ZISDA) ;Delete entry
W " ...DOCUMENT DELETED!!",*7,!
G EXIT
DEL ;Called from mailman to delete the document.
Q ;Obsolete
GETDOC ;Get a spool document to work on.
S Y=-1 Q:$D(DUZ)[0 S ZISPLU=$S($D(^VA(200,DUZ,"SPL")):^("SPL"),1:"") I $P(ZISPLU,"^",1)'["y" W !,?5,*7,"You must be authorized by IRM to use spooling" Q
S DIC=3.51,DIC(0)="AEMQZ" D ^DIC Q:Y<0 I $P(Y(0),U,2)]"" W !,?5,*7,"This spool is still active and can't be worked on." G GETDOC
S ZISDA=+Y,ZISPL0=Y(0) K DIC Q
;
PRINT ;
N %,DIC,DIE,DR,DA,X,Y,ZISPL0,ZISPG,ZISDA,ZISDA2,ZISPLC,ZISFDA,ZISIEN,ZISIOP,ZISMSG
P S DIC("A")="Print which SPOOL DOCUMENT: " D GETDOC K IOP,%ZIS,%IS Q:Y<0
S ZISPG=$P(ZISPL0,U,8) I $P(ZISPL0,U,3)="m" W !,"Sorry, this spool document has been converted into a mail message",!,"and you are unable to print it" G EXIT
I $P(ZISPL0,U,10)'>0 W !,"Sorry there isn't anything to print." G EXIT
I $P(ZISPL0,U,11) D MSG2 S %=2 D YN^DICN G EXIT:%'=1
IO ;
S DIR(0)="N^1:99",DIR("A")="Copies to Print" D ^DIR S ZISPLC=+$G(Y) I $D(DIRUT) G EXIT
U IO(0) S %IS="MQ" D ^%ZIS G:POP EXIT S ZISIOP=ION_";"_IOST_";"_IOM_";"_IOSL
U IO(0) S ZISDA2=$$FIND1^DIC(3.5121,","_ZISDA_",","O",ION)
I ZISDA2>0,$P(^XMB(3.51,ZISDA,2,ZISDA2,0),"^",3) S ZISMSG="This device is currently printing a copy of this document" G CIO
I +ZISPG>IOM!($P(ZISPG,";",2)>IOSL) S ZISMSG="Current page is "_IOM_" by "_IOSL_$C(13,10)_" Page must be at least "_(+ZISPG)_" by "_$P(ZISPG,";",2) G CIO
S %=$S(ZISDA2>0:ZISDA2_",",1:"?+1,")_ZISDA_","
S ZISFDA(3.5121,%,.01)=ION,ZISFDA(3.5121,%,1)=ZISPLC D UPDATE^DIE("","ZISFDA","ZISIEN")
S:ZISDA2'>0 ZISDA2=ZISIEN(1)
W ! I '$D(IO("Q")) S %ZIS="",IOP=ZISIOP D ^%ZIS G:'POP DQP^ZISPL2
S ZTRTN="DQP^ZISPL2",ZTDESC="Print spool document",ZTIO=ZISIOP,ZTSAVE("ZISDA")="",ZTSAVE("ZISDA2")="",ZTSAVE("ZISPLC")=""
K IO("Q") D ^%ZTLOAD,^%ZISC K ZTSK G EXIT:$P(ZISPLU,"^",2)'["y" W !!,"Also send to" G IO
;
CIO ;Close device and go to IO
D ^%ZISC U IO D:$D(ZISMSG) G IO
. W !,ZISMSG K ZISMSG
CEXIT ;Close device and Exit
D ^%ZISC
EXIT D KILL^XUSCLEAN S ZTREQ="@" Q
;
KERMIT ;Use Kermit to send a spooler file
D GETDOC Q:Y'>0 S ZISDA=$P(ZISPL0,U,10) G EXIT:ZISDA'>0 S XTKDIC="^XMBS(3.519,"_ZISDA_",2,",XTKFILE=$P(ZISPL0,U)
D MODE^XTKERMIT G EXIT:$D(DIRUT) D SEND^XTKERMIT G EXIT
;
BROWSE ;Use FM Browser to look at document
D GETDOC Q:Y'>0 S ZISDA=$P(ZISPL0,U,10) G EXIT:ZISDA'>0
D BROWSE^DDBR($NA(^XMBS(3.519,ZISDA,2)),"NR",$P(ZISPL0,U)) G EXIT
;
MAIL ;Make into a mail message
S ZISPLU=$S($D(^VA(200,DUZ,"SPL")):^("SPL"),1:"") I $P(ZISPLU,U,3)["n" W !,"You are not authorized to convert Spool Documents into Mail Messages." G EXIT
S Y=-1 D GETDOC G:Y'>0 EXIT S XS=$P(ZISPL0,"^",10) I 'XS D MSG1 G EXIT
S DIR(0)="Y",DIR("A")="Convert spool doc: "_$P(ZISPL0,U)_" into a mail message",DIR("B")="YES" D ^DIR G EXIT:$D(DIRUT),EXIT:Y'=1
;The following code will move the text from file #3.519 into file #3.9,
S %=$P(ZISPL0,U,9) I '+% D MSG1 G EXIT
G DQMAIL:%<500 W !,"You have "_%_" lines of text to convert into a mail message.",!,"Do you wish to queue this conversion process" S %=1 D YN^DICN G EXIT:$D(DIRUT),DQMAIL:%=2
;
S ZTIO="",ZTRTN="DQMAIL^ZISPL",ZTDESC="Convert spool document into mail message",ZTSAVE("ZISDA")="" D ^%ZTLOAD G EXIT
;
DQMAIL W:'$D(ZTQUEUED) !,"Moving it..."
S ZISPL0=$G(^XMB(3.51,ZISDA,0)),XS=$P(ZISPL0,"^",10),XMY(DUZ)="",XMTEXT="^XMBS(3.519,"_XS_",2,",XMSUB="Spool document: "_$P(ZISPL0,"^")
D:XS>0 ^XMD ;to make new I $D(XMZ) S XMDUZ=DUZ D NNEW^XMA
D DSDOC(ZISDA),DSD(XS) W:'$D(ZTQUEUED) !," Now a normal mail message.."
G EXIT
;
DSD(DA) ;Delete an entry in the spool data file.
Q:DA'>0 N DIK K ^XMB(3.51,"AM",DA) S DIK="^XMBS(3.519," D ^DIK
Q
DSDOC(DA) ;Delete an entry in the spool doc file.
Q:DA'>0 N DIK S DIK="^XMB(3.51," D ^DIK
Q
;
MSG1 W !,"This spool document doesn't have any text." Q
MSG2 W !,"You have exceeded the total spool document line limit allowed."
W !,"Therefore, this spool document is incomplete."
W !!,"Do you still wish to print this document" Q
;
ZISPL ;SF/RWF - UTILITIES FOR SPOOLING ;04/07/98 16:16 [ 04/02/2003 8:29 AM ]
+1 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
+2 ;;8.0;KERNEL;**23,69**;Jul 10, 1995
+3 ;This is the general code for managment of the spooler file.
DELETE ;delete a document from the file.
A SET DIC("A")="Delete which SPOOL DOCUMENT: "
DO GETDOC
IF Y<0
GOTO EXIT
+1 IF '$PIECE(ZISPL0,U,7)
WRITE !,*7,"This Document hasn't been printed. Are you sure??"
+2 SET DIR(0)="S^n:NO;y:YES;c:CLEAR"
SET DIR("A")="...OK TO DELETE"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
IF $DATA(DIRUT)!("yc"'[Y)
GOTO EXIT
+3 ;delete data
SET ZISY=Y
DO DSD($PIECE(ZISPL0,U,10))
+4 IF ZISY["c"
SET X=^XMB(3.51,ZISDA,0)
SET ^(0)=$PIECE(X,"^",1)_"^^^^"_DUZ_"^^^"_$PIECE(X,"^",8)
KILL ^XMB(3.51,ZISDA,2)
WRITE " ... DOCUMENT CLEARED!!"
GOTO EXIT
+5 ;
+6 ;Delete entry
DO DSDOC(ZISDA)
+7 WRITE " ...DOCUMENT DELETED!!",*7,!
+8 GOTO EXIT
DEL ;Called from mailman to delete the document.
+1 ;Obsolete
QUIT
GETDOC ;Get a spool document to work on.
+1 SET Y=-1
IF $DATA(DUZ)[0
QUIT
SET ZISPLU=$SELECT($DATA(^VA(200,DUZ,"SPL")):^("SPL"),1:"")
IF $PIECE(ZISPLU,"^",1)'["y"
WRITE !,?5,*7,"You must be authorized by IRM to use spooling"
QUIT
+2 SET DIC=3.51
SET DIC(0)="AEMQZ"
DO ^DIC
IF Y<0
QUIT
IF $PIECE(Y(0),U,2)]""
WRITE !,?5,*7,"This spool is still active and can't be worked on."
GOTO GETDOC
+3 SET ZISDA=+Y
SET ZISPL0=Y(0)
KILL DIC
QUIT
+4 ;
PRINT ;
+1 NEW %,DIC,DIE,DR,DA,X,Y,ZISPL0,ZISPG,ZISDA,ZISDA2,ZISPLC,ZISFDA,ZISIEN,ZISIOP,ZISMSG
P SET DIC("A")="Print which SPOOL DOCUMENT: "
DO GETDOC
KILL IOP,%ZIS,%IS
IF Y<0
QUIT
+1 SET ZISPG=$PIECE(ZISPL0,U,8)
IF $PIECE(ZISPL0,U,3)="m"
WRITE !,"Sorry, this spool document has been converted into a mail message",!,"and you are unable to print it"
GOTO EXIT
+2 IF $PIECE(ZISPL0,U,10)'>0
WRITE !,"Sorry there isn't anything to print."
GOTO EXIT
+3 IF $PIECE(ZISPL0,U,11)
DO MSG2
SET %=2
DO YN^DICN
IF %'=1
GOTO EXIT
IO ;
+1 SET DIR(0)="N^1:99"
SET DIR("A")="Copies to Print"
DO ^DIR
SET ZISPLC=+$GET(Y)
IF $DATA(DIRUT)
GOTO EXIT
+2 USE IO(0)
SET %IS="MQ"
DO ^%ZIS
IF POP
GOTO EXIT
SET ZISIOP=ION_";"_IOST_";"_IOM_";"_IOSL
+3 USE IO(0)
SET ZISDA2=$$FIND1^DIC(3.5121,","_ZISDA_",","O",ION)
+4 IF ZISDA2>0
IF $PIECE(^XMB(3.51,ZISDA,2,ZISDA2,0),"^",3)
SET ZISMSG="This device is currently printing a copy of this document"
GOTO CIO
+5 IF +ZISPG>IOM!($PIECE(ZISPG,";",2)>IOSL)
SET ZISMSG="Current page is "_IOM_" by "_IOSL_$CHAR(13,10)_" Page must be at least "_(+ZISPG)_" by "_$PIECE(ZISPG,";",2)
GOTO CIO
+6 SET %=$SELECT(ZISDA2>0:ZISDA2_",",1:"?+1,")_ZISDA_","
+7 SET ZISFDA(3.5121,%,.01)=ION
SET ZISFDA(3.5121,%,1)=ZISPLC
DO UPDATE^DIE("","ZISFDA","ZISIEN")
+8 IF ZISDA2'>0
SET ZISDA2=ZISIEN(1)
+9 WRITE !
IF '$DATA(IO("Q"))
SET %ZIS=""
SET IOP=ZISIOP
DO ^%ZIS
IF 'POP
GOTO DQP^ZISPL2
+10 SET ZTRTN="DQP^ZISPL2"
SET ZTDESC="Print spool document"
SET ZTIO=ZISIOP
SET ZTSAVE("ZISDA")=""
SET ZTSAVE("ZISDA2")=""
SET ZTSAVE("ZISPLC")=""
+11 KILL IO("Q")
DO ^%ZTLOAD
DO ^%ZISC
KILL ZTSK
IF $PIECE(ZISPLU,"^",2)'["y"
GOTO EXIT
WRITE !!,"Also send to"
GOTO IO
+12 ;
CIO ;Close device and go to IO
+1 DO ^%ZISC
USE IO
IF $DATA(ZISMSG)
Begin DoDot:1
+2 WRITE !,ZISMSG
KILL ZISMSG
End DoDot:1
GOTO IO
CEXIT ;Close device and Exit
+1 DO ^%ZISC
EXIT DO KILL^XUSCLEAN
SET ZTREQ="@"
QUIT
+1 ;
KERMIT ;Use Kermit to send a spooler file
+1 DO GETDOC
IF Y'>0
QUIT
SET ZISDA=$PIECE(ZISPL0,U,10)
IF ZISDA'>0
GOTO EXIT
SET XTKDIC="^XMBS(3.519,"_ZISDA_",2,"
SET XTKFILE=$PIECE(ZISPL0,U)
+2 DO MODE^XTKERMIT
IF $DATA(DIRUT)
GOTO EXIT
DO SEND^XTKERMIT
GOTO EXIT
+3 ;
BROWSE ;Use FM Browser to look at document
+1 DO GETDOC
IF Y'>0
QUIT
SET ZISDA=$PIECE(ZISPL0,U,10)
IF ZISDA'>0
GOTO EXIT
+2 DO BROWSE^DDBR($NAME(^XMBS(3.519,ZISDA,2)),"NR",$PIECE(ZISPL0,U))
GOTO EXIT
+3 ;
MAIL ;Make into a mail message
+1 SET ZISPLU=$SELECT($DATA(^VA(200,DUZ,"SPL")):^("SPL"),1:"")
IF $PIECE(ZISPLU,U,3)["n"
WRITE !,"You are not authorized to convert Spool Documents into Mail Messages."
GOTO EXIT
+2 SET Y=-1
DO GETDOC
IF Y'>0
GOTO EXIT
SET XS=$PIECE(ZISPL0,"^",10)
IF 'XS
DO MSG1
GOTO EXIT
+3 SET DIR(0)="Y"
SET DIR("A")="Convert spool doc: "_$PIECE(ZISPL0,U)_" into a mail message"
SET DIR("B")="YES"
DO ^DIR
IF $DATA(DIRUT)
GOTO EXIT
IF Y'=1
GOTO EXIT
+4 ;The following code will move the text from file #3.519 into file #3.9,
+5 SET %=$PIECE(ZISPL0,U,9)
IF '+%
DO MSG1
GOTO EXIT
+6 IF %<500
GOTO DQMAIL
WRITE !,"You have "_%_" lines of text to convert into a mail message.",!,"Do you wish to queue this conversion process"
SET %=1
DO YN^DICN
IF $DATA(DIRUT)
GOTO EXIT
IF %=2
GOTO DQMAIL
+7 ;
+8 SET ZTIO=""
SET ZTRTN="DQMAIL^ZISPL"
SET ZTDESC="Convert spool document into mail message"
SET ZTSAVE("ZISDA")=""
DO ^%ZTLOAD
GOTO EXIT
+9 ;
DQMAIL IF '$DATA(ZTQUEUED)
WRITE !,"Moving it..."
+1 SET ZISPL0=$GET(^XMB(3.51,ZISDA,0))
SET XS=$PIECE(ZISPL0,"^",10)
SET XMY(DUZ)=""
SET XMTEXT="^XMBS(3.519,"_XS_",2,"
SET XMSUB="Spool document: "_$PIECE(ZISPL0,"^")
+2 ;to make new I $D(XMZ) S XMDUZ=DUZ D NNEW^XMA
IF XS>0
DO ^XMD
+3 DO DSDOC(ZISDA)
DO DSD(XS)
IF '$DATA(ZTQUEUED)
WRITE !," Now a normal mail message.."
+4 GOTO EXIT
+5 ;
DSD(DA) ;Delete an entry in the spool data file.
+1 IF DA'>0
QUIT
NEW DIK
KILL ^XMB(3.51,"AM",DA)
SET DIK="^XMBS(3.519,"
DO ^DIK
+2 QUIT
DSDOC(DA) ;Delete an entry in the spool doc file.
+1 IF DA'>0
QUIT
NEW DIK
SET DIK="^XMB(3.51,"
DO ^DIK
+2 QUIT
+3 ;
MSG1 WRITE !,"This spool document doesn't have any text."
QUIT
MSG2 WRITE !,"You have exceeded the total spool document line limit allowed."
+1 WRITE !,"Therefore, this spool document is incomplete."
+2 WRITE !!,"Do you still wish to print this document"
QUIT
+3 ;
