INHZISPL.m

%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 ***