%ZISPL ; cmi/flag/maw - MVB,GFT,RMG 30 Dec 94 12:51 UTILITIES FOR SPOOLING IN VAX DSM ; [ 05/22/2002 2:53 PM ]
;;3.01;BHL IHS Interfaces with GIS;**1**;JUL 01, 2001
;CHCS TLS_4602; GEN 2; 12-NOV-1998
;COPYRIGHT 1988, 1989, 1990 SAIC
ZSPLDEL ;
A K DIC S DIC("A")="Delete which SPOOL DOCUMENT: ",DIC=3.51,DIC(0)="AEQMZ"
D DICS,^DIC K DIC Q:Y<0
W !?8,"...Ok to Delete" Q:'$$YN^%ZTF(0,1)
DEL S DR=".01///@",DIE=3.51,DA=+Y,DOC=$P($G(^(1)),U,1) K DIC D ^DIE Q:$D(DA) ;naked on ^XUSPLDSM(+Y,1)
Q
ZTSKDEL ;Entry point for auto delete of documents - works off expiration date
S ZISDA=0 F S ZISDA=$O(^XUSPLDSM(ZISDA)) Q:'ZISDA S X=$G(^(ZISDA,0)) I $L(X),$P(X,U,8),$P(X,U,8)<DT S Y=ZISDA D DEL
Q
;
DELFFN ; external extry point for cross-ref on .01 field of spool document file
; to delete VMS spool file upon deletion of an entry in spool doc file.
S DOC=$P($G(^XUSPLDSM(DA,1)),U),$ZT="PROERR^%ZISPL"
;I $L(DOC),$ZC(%PARSE,DOC,,,"DIRECTORY")'="" O DOC C DOC:DELETE S DOC="",$ZT=""
W !," ...VMS Spool File Deleted!!",*7,!
Q
PROERR I $ZE["-E-PRV"!($ZE["-NOPRIV") W:'$D(ZTSK) !,"Insufficient privilege to delete VMS Spool File.",! Q
ZQ
PERR ;Print selection error - file has been deleted or not created yet (queued)
W !,"A file does not yet exist or has been deleted for this document"
ZSPLPRIN ;
P K DIC S DIC=3.51,DIC(0)="AQMEZ"
D DICS,^DIC K DIC,IOP,%ZIS,%IS Q:Y<0
S ZISDOC=$G(^(1)),ZISDA=+Y ;naked on ^XUSPLDSM(+Y,)
I '$L(ZISDOC) W !,"The file containing document ",$P($G(^XUSPLDSM(ZISDA,0)),U,1)," does not exist",*7 K ZISDOC,ZISDA Q
S $ZT="PERR^%ZISPL",X=1 O ZISDOC:READ:3 S $ZT="" D:'$T C:X ZISDOC I 'X,"Yy"'[$E(X) G P
.W !!!,*7,"This document is currently in use and if this print is not queued your crt"
.W !,"will hang until the document is free"
.R !,"Do you wish to continue ? No// ",X:$S($G(DTIME):DTIME,1:60) S:'$L(X) X="N"
T R !,"Number of Copies: 1// ",ZISCOPY:$S($G(DTIME):DTIME,1:300) G:ZISCOPY=U CLOSE S:'ZISCOPY ZISCOPY=1 I ZISCOPY'?.N W *7," ??" G T
S %ZIS("A")="Output to: ",%ZIS="Q" D ^%ZIS Q:POP
G:'$G(IO("Q")) TCONT
S ZTRTN="ENTSK^%ZISPL",ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL,ZTSAVE("DESC")="Print a Spooled document"
F %="ZISCOPY","ZISDA","ZISDOC" S ZTSAVE(%)=@%
D ^%ZISC S ZTDTH=$H D ^%ZTLOAD K ZTSK G KILL
;
ENTSK ;Entry point from taskman or application print
;variables needed: ZISDOC=VMS spool doc name (optional),
; ZISCOPY=# of copies (optional),
; ZISDA=internal number of spool doc (file 3.51) -REQUIRED
Q:'$G(ZISDA) S:'$D(ZISDOC) ZISDOC=$G(^XUSPLDSM(ZISDA,1)) S:'$D(ZISCOPY) ZISCOPY=1
D:$L(ZISDOC) TCONT K ZISCOPY,ZISDA,ZISDOC K:$G(ZTSK) ^%ZTSK(ZTSK),ZTSK Q
;
TCONT D 1^DICRW S $ZT="NODOC^%ZISPL" O ZISDOC:READ S $ZT="" F ZISCOPY=ZISCOPY:-1:1 D OUT
C ZISDOC S $P(^XUSPLDSM(ZISDA,0),U,7)=$$NOW^%ZTFDT
CLOSE D ^%ZISC
KILL K %,DIC,ZISDOC,ZISCOPY,ZISDA Q
;
NODOC ;Error message if VMS file has been deleted
U IO W !,"The file containing document ",$P($G(^XUSPLDSM(ZISDA,0)),U,1)," does not exist",*7
S $ZT="" D CLOSE Q
OUT S $ZT="OUTERR" U IO:PACK W @IOF F U ZISDOC R X U IO W X,!
OUTERR I $ZE["-ENDOFILE" U ZISDOC:DISCONNECT Q
ZQ
;
DICS ;Build screen for filemanager access - also called from %ZIS2
S DIC("S")="I '$L($P(^(0),U,3))!(DUZ(0)=""@"")!(DUZ(0)[""#"")!($L(DUZ(0))'=$L($TR(DUZ(0),$P(^(0),U,3))))"
Q
;
ZSPLIST ;
L ;
K DIC S D="B",DIC="^XUSPLDSM(",DIC(0)="E"
D DICS,DQ^DICQ K DIC,DO
Q
EDIT ;Edit check of file 3.51 name field
I $L(X)>80!($L(X)<3) W !,"Name too ",$S($L(X<3):"short",1:"long") K X Q
N % F %=1:1:$L(X) I $E(X,%)'?1AN&("- _"'[$E(X,%)) W !,"Sorry, '",$E(X,%),"' is not allowed in spool document name" K X Q
Q
XM ;
S DIC=3.9,DIC(0)="AEQM",DIC("S")="I $P(^(0),U,2)=DUZ",DIC("A")="Select a MAILMAN MESSAGE you have sent: "
S DIC("W")="W ?70 S %=$P(^(0),U,3) W $E(%,4,5)_""/""_$E(%,6,7)_""/""_$E(%,2,3)"
D ^DIC K DIC Q:Y<0 S ZXM=+Y
S DIC=3.51,DIC(0)="AEZMQ" S:DUZ(0)'="@" DIC("S")="I $TR(DUZ(0),$P(^(0),U,3))'=DUZ(0)!'$L($P(^(0),U,3))"
D ^DIC K DIC Q:Y<0 S Z=^(1) F I=1:1 Q:'$D(^XMB9(ZXM,2,I)) ;naked on ^XUSPLDSM(+Y,)
W !,"Are you ready to insert this document,",!?8,"starting as line #"_I_" of the message" Q:'$$YN^%ZTF(1,1)
S $ZT="ERRXM" O Z:READ U Z F I=I:1 R X S ^XMB9(ZXM,2,I,0)=X I I#10 W "."
ERRXM ;EOF CHECK
I $ZE["-ENDOFILE," C Z U 0 S I=I-1,$P(^XMB9(ZXM,2,0),U,3,5)=I_U_I_DT W !!,"..DONE!",!! K %,ZXM,X,Y,Z,I Q
ZQ
%ZISPL ; cmi/flag/maw - MVB,GFT,RMG 30 Dec 94 12:51 UTILITIES FOR SPOOLING IN VAX DSM ; [ 05/22/2002 2:53 PM ]
+1 ;;3.01;BHL IHS Interfaces with GIS;**1**;JUL 01, 2001
+2 ;CHCS TLS_4602; GEN 2; 12-NOV-1998
+3 ;COPYRIGHT 1988, 1989, 1990 SAIC
ZSPLDEL ;
A KILL DIC
SET DIC("A")="Delete which SPOOL DOCUMENT: "
SET DIC=3.51
SET DIC(0)="AEQMZ"
+1 DO DICS
DO ^DIC
KILL DIC
IF Y<0
QUIT
+2 WRITE !?8,"...Ok to Delete"
IF '$$YN^%ZTF(0,1)
QUIT
DEL ;naked on ^XUSPLDSM(+Y,1)
SET DR=".01///@"
SET DIE=3.51
SET DA=+Y
SET DOC=$PIECE($GET(^(1)),U,1)
KILL DIC
DO ^DIE
IF $DATA(DA)
QUIT
+1 QUIT
ZTSKDEL ;Entry point for auto delete of documents - works off expiration date
+1 SET ZISDA=0
FOR
SET ZISDA=$ORDER(^XUSPLDSM(ZISDA))
IF 'ZISDA
QUIT
SET X=$GET(^(ZISDA,0))
IF $LENGTH(X)
IF $PIECE(X,U,8)
IF $PIECE(X,U,8)<DT
SET Y=ZISDA
DO DEL
+2 QUIT
+3 ;
DELFFN ; external extry point for cross-ref on .01 field of spool document file
+1 ; to delete VMS spool file upon deletion of an entry in spool doc file.
+2 SET DOC=$PIECE($GET(^XUSPLDSM(DA,1)),U)
SET $ZT="PROERR^%ZISPL"
+3 ;I $L(DOC),$ZC(%PARSE,DOC,,,"DIRECTORY")'="" O DOC C DOC:DELETE S DOC="",$ZT=""
+4 WRITE !," ...VMS Spool File Deleted!!",*7,!
+5 QUIT
PROERR IF $ZE["-E-PRV"!($ZE["-NOPRIV")
IF '$DATA(ZTSK)
WRITE !,"Insufficient privilege to delete VMS Spool File.",!
QUIT
+1
*** ERROR ***
PERR ;Print selection error - file has been deleted or not created yet (queued)
+1 WRITE !,"A file does not yet exist or has been deleted for this document"
ZSPLPRIN ;
P KILL DIC
SET DIC=3.51
SET DIC(0)="AQMEZ"
+1 DO DICS
DO ^DIC
KILL DIC,IOP,%ZIS,%IS
IF Y<0
QUIT
+2 ;naked on ^XUSPLDSM(+Y,)
SET ZISDOC=$GET(^(1))
SET ZISDA=+Y
+3 IF '$LENGTH(ZISDOC)
WRITE !,"The file containing document ",$PIECE($GET(^XUSPLDSM(ZISDA,0)),U,1)," does not exist",*7
KILL ZISDOC,ZISDA
QUIT
+4 SET $ZT="PERR^%ZISPL"
SET X=1
OPEN ZISDOC:READ:3
SET $ZT=""
IF '$TEST
Begin DoDot:1
+5 WRITE !!!,*7,"This document is currently in use and if this print is not queued your crt"
+6 WRITE !,"will hang until the document is free"
+7 READ !,"Do you wish to continue ? No// ",X:$SELECT($GET(DTIME):DTIME,1:60)
IF '$LENGTH(X)
SET X="N"
End DoDot:1
IF X
CLOSE ZISDOC
IF 'X
IF "Yy"'[$EXTRACT(X)
GOTO P
T READ !,"Number of Copies: 1// ",ZISCOPY:$SELECT($GET(DTIME):DTIME,1:300)
IF ZISCOPY=U
GOTO CLOSE
IF 'ZISCOPY
SET ZISCOPY=1
IF ZISCOPY'?.N
WRITE *7," ??"
GOTO T
+1 SET %ZIS("A")="Output to: "
SET %ZIS="Q"
DO ^%ZIS
IF POP
QUIT
+2 IF '$GET(IO("Q"))
GOTO TCONT
+3 SET ZTRTN="ENTSK^%ZISPL"
SET ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL
SET ZTSAVE("DESC")="Print a Spooled document"
+4 FOR %="ZISCOPY","ZISDA","ZISDOC"
SET ZTSAVE(%)=@%
+5 DO ^%ZISC
SET ZTDTH=$HOROLOG
DO ^%ZTLOAD
KILL ZTSK
GOTO KILL
+6 ;
ENTSK ;Entry point from taskman or application print
+1 ;variables needed: ZISDOC=VMS spool doc name (optional),
+2 ; ZISCOPY=# of copies (optional),
+3 ; ZISDA=internal number of spool doc (file 3.51) -REQUIRED
+4 IF '$GET(ZISDA)
QUIT
IF '$DATA(ZISDOC)
SET ZISDOC=$GET(^XUSPLDSM(ZISDA,1))
IF '$DATA(ZISCOPY)
SET ZISCOPY=1
+5 IF $LENGTH(ZISDOC)
DO TCONT
KILL ZISCOPY,ZISDA,ZISDOC
IF $GET(ZTSK)
KILL ^%ZTSK(ZTSK),ZTSK
QUIT
+6 ;
TCONT DO 1^DICRW
SET $ZT="NODOC^%ZISPL"
OPEN ZISDOC:READ
SET $ZT=""
FOR ZISCOPY=ZISCOPY:-1:1
DO OUT
+1 CLOSE ZISDOC
SET $PIECE(^XUSPLDSM(ZISDA,0),U,7)=$$NOW^%ZTFDT
CLOSE DO ^%ZISC
KILL KILL %,DIC,ZISDOC,ZISCOPY,ZISDA
QUIT
+1 ;
NODOC ;Error message if VMS file has been deleted
+1 USE IO
WRITE !,"The file containing document ",$PIECE($GET(^XUSPLDSM(ZISDA,0)),U,1)," does not exist",*7
+2 SET $ZT=""
DO CLOSE
QUIT
OUT SET $ZT="OUTERR"
USE IO:PACK
WRITE @IOF
FOR
USE ZISDOC
READ X
USE IO
WRITE X,!
OUTERR IF $ZE["-ENDOFILE"
USE ZISDOC:DISCONNECT
QUIT
+1
*** ERROR ***
+2 ;
DICS ;Build screen for filemanager access - also called from %ZIS2
+1 SET DIC("S")="I '$L($PL_source.html#xP">P(^(0),U,3))!(DUZ(0)=""@"")!(DUZ(0)[""#"")!($L(DUZ(0))'=$L($TR(DUZ(0),$PL_source.html#xP">P(^(0),U,3))))"
+2 QUIT
+3 ;
ZSPLIST ;
L ;
+1 KILL DIC
SET D="B"
SET DIC="^XUSPLDSM("
SET DIC(0)="E"
+2 DO DICS
DO DQ^DICQ
KILL DIC,DO
+3 QUIT
EDIT ;Edit check of file 3.51 name field
+1 IF $LENGTH(X)>80!($LENGTH(X)<3)
WRITE !,"Name too ",$SELECT($LENGTH(X<3):"short",1:"long")
KILL X
QUIT
+2 NEW %
FOR %=1:1:$LENGTH(X)
IF $EXTRACT(X,%)'?1AN&("- _"'[$EXTRACT(X,%))
WRITE !,"Sorry, '",$EXTRACT(X,%),"' is not allowed in spool document name"
KILL X
QUIT
+3 QUIT
XM ;
+1 SET DIC=3.9
SET DIC(0)="AEQM"
SET DIC("S")="I $P(^(0),U,2)=DUZ"
SET DIC("A")="Select a MAILMAN MESSAGE you have sent: "
+2 SET DIC("W")="W ?70 S %=$P(^(0),U,3) W $E(%,4,5)_""/""_$E(%,6,7)_""/""_$E(%,2,3)"
+3 DO ^DIC
KILL DIC
IF Y<0
QUIT
SET ZXM=+Y
+4 SET DIC=3.51
SET DIC(0)="AEZMQ"
IF DUZ(0)'="@"
SET DIC("S")="I $TR(DUZ(0),$PL_source.html#xP">P(^(0),U,3))'=DUZ(0)!'$L($PL_source.html#xP">P(^(0),U,3))"
+5 ;naked on ^XUSPLDSM(+Y,)
DO ^DIC
KILL DIC
IF Y<0
QUIT
SET Z=^(1)
FOR I=1:1
IF '$DATA(^XMB9(ZXM,2,I))
QUIT
+6 WRITE !,"Are you ready to insert this document,",!?8,"starting as line #"_I_" of the message"
IF '$$YN^%ZTF(1,1)
QUIT
+7 SET $ZT="ERRXM"
OPEN Z:READ
USE Z
FOR I=I:1
READ X
SET ^XMB9(ZXM,2,I,0)=X
IF I#10
WRITE "."
ERRXM ;EOF CHECK
+1 IF $ZE["-ENDOFILE,"
CLOSE Z
USE 0
SET I=I-1
SET $PIECE(^XMB9(ZXM,2,0),U,3,5)=I_U_I_DT
WRITE !!,"..DONE!",!!
KILL %,ZXM,X,Y,Z,I
QUIT
+2
*** ERROR ***
