- ZISPL ;SF/RWF - UTILITIES FOR SPOOLING ;03/31/2003 08:53
- ;;8.0;KERNEL;**23,69,291**;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 !,$C(13),"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!!",$C(13),!
- 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,$C(13),"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,$C(13),"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 (move text from file #3.519 to file #3.9)
- N ZISPLU,ZISDA,ZISPL0,XS,ZISLINES,DIR,X,Y
- S ZISPLU=$G(^VA(200,DUZ,"SPL")) I $P(ZISPLU,U,3)["n" W !,"You are not authorized to convert Spool Documents into MailMan Messages." G EXIT
- D GETDOC G:'$D(ZISPL0) EXIT
- S XS=$P(ZISPL0,"^",10) I 'XS D MSG1 G EXIT
- S ZISLINES=$P(ZISPL0,U,9) I '+ZISLINES D MSG1 G EXIT
- K DIR,X,Y
- S DIR(0)="Y"
- S DIR("A")="Convert spool doc: "_$P(ZISPL0,U)_" into a MailMan message"
- S DIR("B")=$$EZBLD^DIALOG(39054) ; Yes
- D ^DIR G:'Y EXIT
- N XMDUZ,ZISSUBJ,ZISINSTR,ZISABORT,XMV
- S ZISABORT=0
- D INITAPI^XMVVITAE
- D ASK(.ZISSUBJ,.ZISINSTR,.ZISABORT) I ZISABORT G CLEAN
- G:ZISLINES<500 MAILIT
- W !
- K DIR,X,Y
- S DIR(0)="Y"
- S DIR("A",1)="You have "_ZISLINES_" lines of text to convert into a MailMan message."
- S DIR("A")="Do you wish to queue this conversion process"
- S DIR("B")=$$EZBLD^DIALOG(39054) ; Yes
- D ^DIR I $D(DIRUT) G CLEAN
- G:'Y MAILIT
- N ZTIO,ZTRTN,ZTDESC,ZTDTH,ZTSAVE,I
- S ZTIO="",ZTRTN="MAILTASK^ZISPL",ZTDESC="Convert spool document into MailMan message"
- F I="ZISDA","XMDUZ","ZISSUBJ","ZISINSTR(","XMV(","^TMP(""XMY"",$J,","^TMP(""XMY0"",$J," S ZTSAVE(I)=""
- D ^%ZTLOAD
- I '$G(ZTSK) W !,"Queueing failed."
- E W !,$$EZBLD^DIALOG(34501.1,ZTSK) ; Request queued. Task number: |1|
- G CLEAN
- MAILTASK ;
- N XS
- S XS=$P($G(^XMB(3.51,ZISDA,0)),"^",10)
- I 'XS D DSDOC(ZISDA) Q
- MAILIT ;
- W:'$D(ZTQUEUED) !!,$$EZBLD^DIALOG(34234) ; Moving to a MailMan message...
- N XMZ
- D CRE8XMZ^XMXAPI(ZISSUBJ,.XMZ) I $D(XMERR) G CLEAN
- D MOVEBODY^XMXAPI(XMZ,"^XMBS(3.519,"_XS_",2)") I $D(XMERR) G CLEAN
- W:'$D(ZTQUEUED) !,$$EZBLD^DIALOG(34236) ; Finished moving.
- D SENDMSG^XMAPHOST(DUZ,XMZ,.ZISINSTR)
- D DSDOC(ZISDA),DSD(XS)
- CLEAN ;
- I $D(XMERR) D
- . I '$D(ZTQUEUED) D SHOWERR^XMXAPIU Q
- . K XMERR,^TMP("XMERR",$J)
- D CLEANUP^XMXADDR
- G EXIT
- ASK(ZISSUBJ,ZISINSTR,ZISABORT) ;
- S ZISSUBJ=$E("Spool document: "_$P(ZISPL0,"^"),1,65)
- D SUBJ^XMXAPIU(.ZISSUBJ) I $D(XMERR) S ZISABORT=1 Q
- D FROMWHOM^XMAPHOST(DUZ,.ZISINSTR,.ZISABORT) Q:ZISABORT
- S ZISINSTR("ADDR FLAGS")="R"
- D TOWHOM^XMXAPIU(DUZ,"","S",.ZISINSTR)
- I $D(XMERR) S ZISABORT=1
- Q
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HZISPL 5830 printed Jan 18, 2025@03:16:20 Page 2
- ZISPL ;SF/RWF - UTILITIES FOR SPOOLING ;03/31/2003 08:53
- +1 ;;8.0;KERNEL;**23,69,291**;Jul 10, 1995
- +2 ;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 !,$CHAR(13),"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!!",$CHAR(13),!
- +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,$CHAR(13),"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,$CHAR(13),"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 (move text from file #3.519 to file #3.9)
- +1 NEW ZISPLU,ZISDA,ZISPL0,XS,ZISLINES,DIR,X,Y
- +2 SET ZISPLU=$GET(^VA(200,DUZ,"SPL"))
- IF $PIECE(ZISPLU,U,3)["n"
- WRITE !,"You are not authorized to convert Spool Documents into MailMan Messages."
- GOTO EXIT
- +3 DO GETDOC
- if '$DATA(ZISPL0)
- GOTO EXIT
- +4 SET XS=$PIECE(ZISPL0,"^",10)
- IF 'XS
- DO MSG1
- GOTO EXIT
- +5 SET ZISLINES=$PIECE(ZISPL0,U,9)
- IF '+ZISLINES
- DO MSG1
- GOTO EXIT
- +6 KILL DIR,X,Y
- +7 SET DIR(0)="Y"
- +8 SET DIR("A")="Convert spool doc: "_$PIECE(ZISPL0,U)_" into a MailMan message"
- +9 ; Yes
- SET DIR("B")=$$EZBLD^DIALOG(39054)
- +10 DO ^DIR
- if 'Y
- GOTO EXIT
- +11 NEW XMDUZ,ZISSUBJ,ZISINSTR,ZISABORT,XMV
- +12 SET ZISABORT=0
- +13 DO INITAPI^XMVVITAE
- +14 DO ASK(.ZISSUBJ,.ZISINSTR,.ZISABORT)
- IF ZISABORT
- GOTO CLEAN
- +15 if ZISLINES<500
- GOTO MAILIT
- +16 WRITE !
- +17 KILL DIR,X,Y
- +18 SET DIR(0)="Y"
- +19 SET DIR("A",1)="You have "_ZISLINES_" lines of text to convert into a MailMan message."
- +20 SET DIR("A")="Do you wish to queue this conversion process"
- +21 ; Yes
- SET DIR("B")=$$EZBLD^DIALOG(39054)
- +22 DO ^DIR
- IF $DATA(DIRUT)
- GOTO CLEAN
- +23 if 'Y
- GOTO MAILIT
- +24 NEW ZTIO,ZTRTN,ZTDESC,ZTDTH,ZTSAVE,I
- +25 SET ZTIO=""
- SET ZTRTN="MAILTASK^ZISPL"
- SET ZTDESC="Convert spool document into MailMan message"
- +26 FOR I="ZISDA","XMDUZ","ZISSUBJ","ZISINSTR(","XMV(","^TMP(""XMY"",$J,","^TMP(""XMY0"",$J,"
- SET ZTSAVE(I)=""
- +27 DO ^%ZTLOAD
- +28 IF '$GET(ZTSK)
- WRITE !,"Queueing failed."
- +29 ; Request queued. Task number: |1|
- IF '$TEST
- WRITE !,$$EZBLD^DIALOG(34501.1,ZTSK)
- +30 GOTO CLEAN
- MAILTASK ;
- +1 NEW XS
- +2 SET XS=$PIECE($GET(^XMB(3.51,ZISDA,0)),"^",10)
- +3 IF 'XS
- DO DSDOC(ZISDA)
- QUIT
- MAILIT ;
- +1 ; Moving to a MailMan message...
- if '$DATA(ZTQUEUED)
- WRITE !!,$$EZBLD^DIALOG(34234)
- +2 NEW XMZ
- +3 DO CRE8XMZ^XMXAPI(ZISSUBJ,.XMZ)
- IF $DATA(XMERR)
- GOTO CLEAN
- +4 DO MOVEBODY^XMXAPI(XMZ,"^XMBS(3.519,"_XS_",2)")
- IF $DATA(XMERR)
- GOTO CLEAN
- +5 ; Finished moving.
- if '$DATA(ZTQUEUED)
- WRITE !,$$EZBLD^DIALOG(34236)
- +6 DO SENDMSG^XMAPHOST(DUZ,XMZ,.ZISINSTR)
- +7 DO DSDOC(ZISDA)
- DO DSD(XS)
- CLEAN ;
- +1 IF $DATA(XMERR)
- Begin DoDot:1
- +2 IF '$DATA(ZTQUEUED)
- DO SHOWERR^XMXAPIU
- QUIT
- +3 KILL XMERR,^TMP("XMERR",$JOB)
- End DoDot:1
- +4 DO CLEANUP^XMXADDR
- +5 GOTO EXIT
- ASK(ZISSUBJ,ZISINSTR,ZISABORT) ;
- +1 SET ZISSUBJ=$EXTRACT("Spool document: "_$PIECE(ZISPL0,"^"),1,65)
- +2 DO SUBJ^XMXAPIU(.ZISSUBJ)
- IF $DATA(XMERR)
- SET ZISABORT=1
- QUIT
- +3 DO FROMWHOM^XMAPHOST(DUZ,.ZISINSTR,.ZISABORT)
- if ZISABORT
- QUIT
- +4 SET ZISINSTR("ADDR FLAGS")="R"
- +5 DO TOWHOM^XMXAPIU(DUZ,"","S",.ZISINSTR)
- +6 IF $DATA(XMERR)
- SET ZISABORT=1
- +7 QUIT
- 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
- MSG1 WRITE !,"This spool document doesn't have any text."
- +1 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"
- +3 QUIT