ZISPQ ;IRMFO-ALB/CJM - DEVICE HANDLER PRINT QUEUES;10/05/2011 ;08/01/2012
;;8.0;KERNEL;**585**;JUL 10, 9;Build 22
;Per VHA Directive 10-93-142, this routine should not be modified.
;
QEXIST(DEVICE) ;
;Check if print queue exists for this device on this system
;
;Input:
; DEVICE = ien of device
;Output:
; Function returns 1 if queue associated with DEVICE exists, 0 otherwise
;
N OS,PQ
S PQ=$$GETPQ(DEVICE)
Q:PQ="" 0
S OS=$$OS^%ZOSV()
I OS["UNIX" Q $$LQEXIST(PQ)
E I OS["VMS" Q $$VQEXIST(PQ)
Q 0
;
OPEN ;called from PQ^%ZIS6
;
;override %ZIS input parameters and device file parameters for printer queues
;
W:'$D(IOP) !
D:'POP&(%ZISB&(%ZIS'["T"))
.K %ZIS("IOPAR"),%ZIS("IOUPAR")
.S %ZISTO=2
.S $P(%ZTIME,"^",3)="n"
.I $$OS^%ZOSV()["UNIX" D
..S %ZISOPAR="(""NWU"":/TER=$CHAR(13))"
.E D
..S %ZISOPAR="(""NWS"")"
.S %ZISUPAR=""
.S IO=$$NEWJOB(%E,+$G(DUZ)) ;get a unique name for host file
.Q:IO=""
.I $$FEXIST(IO) D FDELETE(IO) ;make sure the file does not exist - it should not!
.S %ZISLOCK=$NA(^%ZIS("lock",IO))
.D O^%ZIS4
.I POP D STATUS(IO,"QE")
;
Q
;
DIR(CODE) ;get directory for printer queues, a subdirectory of host file directory
;Input - CODE (optional) 1 for primary, 2 for secondary. If not passed, the directory of the current process is assumed
N DIR
I '$G(CODE) S CODE=$$PRI^%ZOSV
S DIR=$$CHKNM^%ZISF($P($G(^XTV(8989.3,1,"DEV")),"^",CODE))
I $$OS^%ZOSV()["VMS" D
.S DIR=$P(DIR,"]")_".print_queues]"
E D
.I $E(DIR,$L(DIR))'="/" S DIR=DIR_"/"
.S DIR=DIR_"print_queues/"
Q DIR
;
NEWJOB(DEVICE,DUZ) ;
;Creates a new entry in the PRINT QUEUE JOB file and creates a unique
;name for the print file.
;
;Input:
; DEVICE - ien of the device
; DUZ
;Output:
; Function value - returns the full path name of the host file for the print queue.
;
N I,DATA,DIR,PQ,JOB
I '$G(DEVICE) S POP=1 Q ""
;
;Get the name of the print queue
S PQ=$$GETPQ(DEVICE)
I PQ="" S POP=1 Q ""
;
S DATA(.01)=DEVICE,DATA(.02)=$$NOW^XLFDT,DATA(.04)=DUZ,DATA(.05)=PQ,DATA(.09)=$$PRI^%ZOSV
S JOB=$$ADD^ZISFM(3.52,,.DATA,.ERROR)
Q:'JOB ""
;
;add the status
S DATA(.07)="O"
;add the filename -including the UCI and ien guarantees it to be unique
S DATA(.06)="PQ$"_$$UCI_"_"_JOB_".TXT"
D UPD^ZISFM(3.52,JOB,.DATA,.ERROR)
Q $$DIR_DATA(.06)
;
STATUS(IO,STATUS,JOBID) ;Set the status of the PRINT QUEUE JOB
;Input:
; IO - file name, may include or not include the path, the ien is parsed out.
; STATUS (optional) status code. If ="" returns the current status.
; JOBID (optional) The job id. Should be passed in if the status is 'Q'ueued
;Output:
; function returns the current status
;
N IEN,DATA,ERROR
Q:'$L($G(IO)) ""
S IEN=$$GETIEN(IO)
Q:IEN="" ""
I $G(STATUS)="" Q $P($G(^%ZIS(3.52,IEN,0)),"^",7)
I $L($G(JOBID)) S DATA(.08)=JOBID
S DATA(.07)=STATUS
I $E(STATUS,1)="Q" S DATA(.03)=$$NOW^XLFDT
I STATUS="C",$P($G(^%ZIS(3.52,IEN,0)),"^",7)="C" S DATA(.03)=$$NOW^XLFDT
D UPD^ZISFM(3.52,IEN,.DATA,.ERROR)
Q STATUS
;
CLOSE(IO) ;Called from ^%ZISC. Closes the host file and passes it to the print queue
;
N JOBID,STATUS
;
S STATUS=$$STATUS(IO)
;
;queued tasks are calling CLOSE logic twice, check for that
I (STATUS="Q")!(STATUS="P")!(STATUS="D") Q
;
I '$$PRINT(IO,.JOBID) S STATUS="QE"
E S STATUS="Q"
D STATUS(IO,STATUS,$G(JOBID))
Q
;
VQEXIST(Q) ; Tests if queue exists on this node - VMS
;Function returns 1 if the queue exists, 0 if it doesn't
;
N CMD,RET
S CMD="PIPE Q = F$GETQUI(""DISPLAY_QUEUE"",""QUEUE_NAME"","""_Q_""")"
S CMD=CMD_" ; IF F$LENGTH(Q) .EQ. 0 THEN DEFINE/JOB ZIS$VAL 0 ; IF F$LENGTH(Q) .GT. 0 THEN DEFINE/JOB ZIS$VAL 1 "
I $ZF(-1,CMD)
S RET=$ZF("TRNLNM","ZIS$VAL","LNM$JOB")
I $ZF(-1,"DEASSIGN/JOB ZIS$VAL")
Q +$G(RET)
;
LQEXIST(Q) ; Tests if queue exists - LINUX
N EOF,CMD,RESULTS,RET
S EOF=$ZU(68,40,1)
S CMD="lpstat -p "_$$REPLACE(Q,"$","'$'")_" 2> /dev/null"
O CMD:"qr" U CMD R RESULTS:2 C CMD
I RESULTS]"" S RET=1
S EOF=$ZU(68,40,EOF)
Q +$G(RET)
;
PRINT(FILE,JOBID) ;Submits the file to be printed.
;Input:
; FILE - full file name, including path
;Output:
; function value - returns 1 on success, 0 on failure
; JOBID (pass by reference) on sucess may return the job id for the print job (not guaranteed)
N OS,JOB
S JOB=FILE
Q:'$$GETJOB(.JOB) 0
S OS=$$OS^%ZOSV()
I OS["UNIX" Q $$LPRINT(FILE,JOB("QUEUE"),.JOBID)
I OS["VMS" Q $$VPRINT(FILE,JOB("QUEUE"),.JOBID)
Q 0
;
LPRINT(FILE,Q,JOBID) ;
N CMD,RESULT,EOF,RET
S RET=0,JOBID=""
S CMD="lpr -r -P"_Q_" "_FILE_" && echo success && lpq -P "_Q
S CMD=$$REPLACE(CMD,"$","'$'")
S EOF=$ZU(68,40,1)
O CMD:"QR":5 Q:'$T U CMD D C CMD
.R RESULT:5 Q:'$T Q:RESULT=""
.I RESULT["success" D
..N NAME
..S NAME="PQ$JOB_"_$P(FILE,"PQ$JOB_",2)
..S RET=1
..F R RESULT:5 Q:'$T Q:RESULT="" I RESULT[NAME S JOBID=$$INVERT^XLFSTR($P($$INVERT^XLFSTR($$TRIM^XLFSTR($P(RESULT,NAME),"R"))," ")) Q
S EOF=$ZU(68,40,EOF)
Q RET
;
VPRINT(FILE,Q,JOBID) ; VMS Print
;First determine the /PASS or /NOPASS parameter
N CMD,PASS,NOPASS,RET
S RET=0,JOBID=""
S CMD="PIPE DESCR = F$GETQUI(""DISPLAY_QUEUE"",""QUEUE_DESCRIPTION"","""_Q_""")"
S CMD=CMD_" ; IF F$LOCATE( ""/NOPASS"",DESCR) .LT. F$LENGTH(DESCR) THEN DEFINE/JOB ZIS$VAL 1 "
I $ZF(-1,CMD)
;
S NOPASS=+$ZF("TRNLNM","ZIS$VAL","LNM$JOB")
I $ZF(-1,"DEASSIGN/JOB/NOLOG ZIS$VAL")
S PASS=$S(NOPASS:"/NOPASS",1:"/PASS")
;
;Build the complete VMS PRINT command
S CMD="PIPE PRINT/DELETE"_PASS_"/NOIDENTITY/QUEUE="""_Q_""" "_FILE_" /PARAM=NOFLAG ; IF $STATUS THEN DEFINE/JOB ZIS$VAL &$ENTRY "
;
I $ZF(-1,CMD)=1 D
.S JOBID=$ZF("TRNLNM","ZIS$VAL","LNM$JOB")
I JOBID'="",$ZF(-1,"DEASSIGN/JOB/NOLOG ZIS$VAL")
Q JOBID'=""
;
GETPQ(DEVICE) ;
;Given the ien of the DEVICE, it returns the name of the print queue,
;parsed from the $I or SECONDARY $I field of the DEVICE
;
;Returns "" on failure
;
Q:'$G(DEVICE) ""
N PQ
;
;get $I and parse out the name of the print queue
S:$$PRI^%ZOSV=2 PQ=$P($G(^%ZIS(1,DEVICE,2)),"^")
S:$G(PQ)="" PQ=$P($G(^%ZIS(1,DEVICE,0)),"^",2)
;
;$I field might look like this: DEV:[TEMP]HF_QUEUE.TXT - parse out thequeue name
I PQ[":" S PQ=$P(PQ,":",2)
S PQ=$P(PQ,".",1)
I PQ["]" S PQ=$P(PQ,"]",2)
;
Q PQ
;
REPLACE(STRING,SUB1,SUB2) ;
N REPLACE
S REPLACE(SUB1)=SUB2
Q $$REPLACE^XLFSTR(STRING,.REPLACE)
;
ID ;identifier logic on the PRINT QUEUES JOB file
N ID,NAME,DATE
S NAME=$P(^(0),"^",4)
S DATE=$P(^(0),"^",2)
I NAME S NAME=$$LJ^XLFSTR($P($G(^VA(200,NAME,0)),"^"),18)_" "
I DATE S DATE=$$FMTE^XLFDT(DATE)
S ID=$E(NAME,1,20)_" "_DATE
D EN^DDIOL(ID,"")
Q
;
PURGE ;Purge of PRINT JOB QUEUES (file #3.52) and old host files that were queued. Also updates status on a regular basis.
;
N DEVICE,STATUS,TIME,IEN,DIR,T1,T2,T3,NOW
S NOW=$$NOW^XLFDT
S ZTREQ=""
;
;set time parameters for this purge
S T1=$$FMADD^XLFDT(NOW,,-1) ;10 minutes ago
S T2=$$FMADD^XLFDT(NOW,-1) ;24 hours ago
S T3=$$FMADD^XLFDT(NOW,-2) ;48 hours ago
;
S DIR=$$PRI^%ZOSV
;
L +%ZIS(3.52,"PURGE JOB"_DIR):0 Q:'$T ;allow only one purge at a time on each system (primary, secondary)
;
;look for queued jobs older than 10 minutes whose status can be changed to 'PRINTED & DELETED'
S STATUS="Q"
S DEVICE=0
F S DEVICE=$O(^%ZIS(3.52,"E",DIR,DEVICE)) Q:'DEVICE D
.S TIME=T2 F S TIME=$O(^%ZIS(3.52,"E",DIR,DEVICE,STATUS,TIME)) Q:'TIME Q:TIME>T1 D
..S IEN=0 F S IEN=$O(^%ZIS(3.52,"E",DIR,DEVICE,STATUS,TIME,IEN)) Q:'IEN D
...N JOB S JOB=IEN
...I '$$GETJOB(.JOB) Q
...;if the host file is gone, it has been printed
...I $$FEXIST(JOB("FILE")) D STATUS(JOB("FILE"),"D")
;
;delete host files older than 24 hours
S DEVICE=0
F S DEVICE=$O(^%ZIS(3.52,"E",DIR,DEVICE)) Q:'DEVICE D
.Q:$$STOPPED(DEVICE)
.S STATUS=""
.F S STATUS=$O(^%ZIS(3.52,"E",DIR,DEVICE,STATUS)) Q:STATUS="" I STATUS'="P",STATUS'="D" D
..S TIME=0
..F S TIME=$O(^%ZIS(3.52,"E",DIR,DEVICE,STATUS,TIME)) Q:'TIME Q:TIME>T2 D
...S IEN=0 F S IEN=$O(^%ZIS(3.52,"E",DIR,DEVICE,STATUS,TIME,IEN)) Q:'IEN D
....N JOB S JOB=IEN
....I '$$GETJOB(.JOB) K ^%ZIS(3.52,"E",DIR,DEVICE,STATUS,TIME,IEN) Q
....;delete the host file if it exists and change the status
....I $$FEXIST(JOB("FILE")) D FDELETE(JOB("FILE")),STATUS(JOB("FILE"),"D")
;
;delete jobs (file #3.52) older than 48 hours
S DEVICE=0
F S DEVICE=$O(^%ZIS(3.52,"E",DIR,DEVICE)) Q:'DEVICE D
.Q:$$STOPPED(DEVICE)
.S STATUS="" F S STATUS=$O(^%ZIS(3.52,"E",DIR,DEVICE,STATUS)) Q:STATUS="" D
..S TIME=0 F S TIME=$O(^%ZIS(3.52,"E",DIR,DEVICE,STATUS,TIME)) Q:'TIME Q:TIME>T3 D
...S IEN=0 F S IEN=$O(^%ZIS(3.52,"E",DIR,DEVICE,STATUS,TIME,IEN)) Q:'IEN D
....N JOB S JOB=IEN
....I '$$GETJOB(.JOB) K ^%ZIS(3.52,"E",DIR,DEVICE,STATUS,TIME,IEN) Q
....;delete the job entry (file #3.52)
....D JDELETE(IEN)
;
L -%ZIS(3.52,"PURGE JOB"_DIR)
Q
;
GETJOB(JOB) ;returns job info (file 3.52). Input JOB=ien OR the name of the host file, returns .JOB array with job's fields
N NODE,FILE,DIR,IEN
S IEN=$G(JOB)
I 'IEN,$L(IEN) S IEN=$$GETIEN(IEN)
Q:'IEN ""
S JOB("IEN")=IEN
S NODE=$G(^%ZIS(3.52,IEN,0))
Q:NODE="" 0
S JOB("QUEUE")=$P(NODE,"^",5)
S JOB("ID")=$P(NODE,"^",8)
S FILE=$P(NODE,"^",6)
S DIR=$P(NODE,"^",9)
S DIR=$$DIR(DIR)
S FILE=DIR_FILE
S JOB("FILE")=FILE
Q 1
;
STOPPED(DEVICE) ;was purging suspended for this device?
N RET
S RET=$P($G(^%ZIS(1,+DEVICE,0)),"^",13)
I RET="N" Q 1
Q 0
;
FEXIST(FILE) ;returns 1 if the file exists, 0 otherwise
;
N OS S OS=$$OS^%ZOSV()
I OS["UNIX" Q $$LFEXIST(FILE)
E I OS["VMS" Q $$VFEXIST(FILE)
Q 0
;
VFEXIST(FILE) ;checks file's existance - VMS
N CMD,RET
S CMD="PIPE F = F$SEARCH("""_FILE_""")"
S CMD=CMD_" ; IF F$LENGTH(F) .EQ. 0 THEN DEFINE/JOB ZIS$VAL 0 ; IF F$LENGTH(F) .GT. 0 THEN DEFINE/JOB ZIS$VAL 1 "
I $ZF(-1,CMD)
S RET=$ZF("TRNLNM","ZIS$VAL","LNM$JOB")
I $ZF(-1,"DEASSIGN/JOB ZIS$VAL")
Q +$G(RET)
;
LFEXIST(FILE) ;checks file's existance - Linux,Unix
N CMD
S CMD="[ -f "_$$REPLACE(FILE,"$","'$'")_" ]"
Q '$ZF(-1,CMD)
;
FDELETE(FILE) ;delete file
N OS S OS=$$OS^%ZOSV()
I OS["UNIX" D LFDELETE(FILE)
E I OS["VMS" D VFDELETE(FILE)
Q
;
VFDELETE(FILE) ;delete file - VMS
N CMD
I FILE'[";" S FILE=FILE_";*"
S CMD="DELETE "_FILE
I $ZF(-1,CMD)
Q
;
LFDELETE(FILE) ;delete file - Linux,Unix
N CMD
S CMD="rm -f "_$$REPLACE(FILE,"$","'$'")
I $ZF(-1,CMD)
Q
;
JDELETE(IEN) ;delete the job, file #3.52
D DELETE^ZISFM(3.52,IEN)
Q
;
DEQUEUE(JOBID,QUEUE) ;Remove a job from a queue
N OS S OS=$$OS^%ZOSV()
I OS["UNIX" Q $$LDEQUEUE(JOBID,QUEUE)
E I OS["VMS" Q $$VDEQUEUE(JOBID,QUEUE)
Q
;
VDEQUEUE(JOBID,QUEUE) ;Remove a job from a queue - VMS
I $ZF(-1,"DELETE /ENTRY="_JOBID_" "_QUEUE)
Q
;
LDEQUEUE(JOBID,QUEUE) ;Remove a job from a queue - Linux, Unix
N CMD
S CMD="lprm -P "_$$REPLACE(QUEUE,"$","'$'")_" "_JOBID
I $ZF(-1,CMD)
Q
UCI() ;return the UCI
N Y
X ^%ZOSF("UCI")
Q $P(Y,",")
;
GETIEN(FILE) ;given the file name, parses out the ien and returns it
Q $P($P(FILE,"PQ$"_$$UCI_"_",2),".TXT")
;
;
;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HZISPQ 11303 printed Dec 13, 2024@02:15:12 Page 2
ZISPQ ;IRMFO-ALB/CJM - DEVICE HANDLER PRINT QUEUES;10/05/2011 ;08/01/2012
+1 ;;8.0;KERNEL;**585**;JUL 10, 9;Build 22
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
QEXIST(DEVICE) ;
+1 ;Check if print queue exists for this device on this system
+2 ;
+3 ;Input:
+4 ; DEVICE = ien of device
+5 ;Output:
+6 ; Function returns 1 if queue associated with DEVICE exists, 0 otherwise
+7 ;
+8 NEW OS,PQ
+9 SET PQ=$$GETPQ(DEVICE)
+10 if PQ=""
QUIT 0
+11 SET OS=$$OS^%ZOSV()
+12 IF OS["UNIX"
QUIT $$LQEXIST(PQ)
+13 IF '$TEST
IF OS["VMS"
QUIT $$VQEXIST(PQ)
+14 QUIT 0
+15 ;
OPEN ;called from PQ^%ZIS6
+1 ;
+2 ;override %ZIS input parameters and device file parameters for printer queues
+3 ;
+4 if '$DATA(IOP)
WRITE !
+5 if 'POP&(%ZISB&(%ZIS'["T"))
Begin DoDot:1
+6 KILL %ZIS("IOPAR"),%ZIS("IOUPAR")
+7 SET %ZISTO=2
+8 SET $PIECE(%ZTIME,"^",3)="n"
+9 IF $$OS^%ZOSV()["UNIX"
Begin DoDot:2
+10 SET %ZISOPAR="(""NWU"":/TER=$CHAR(13))"
End DoDot:2
+11 IF '$TEST
Begin DoDot:2
+12 SET %ZISOPAR="(""NWS"")"
End DoDot:2
+13 SET %ZISUPAR=""
+14 ;get a unique name for host file
SET IO=$$NEWJOB(%E,+$GET(DUZ))
+15 if IO=""
QUIT
+16 ;make sure the file does not exist - it should not!
IF $$FEXIST(IO)
DO FDELETE(IO)
+17 SET %ZISLOCK=$NAME(^%ZIS("lock",IO))
+18 DO O^%ZIS4
+19 IF POP
DO STATUS(IO,"QE")
End DoDot:1
+20 ;
+21 QUIT
+22 ;
DIR(CODE) ;get directory for printer queues, a subdirectory of host file directory
+1 ;Input - CODE (optional) 1 for primary, 2 for secondary. If not passed, the directory of the current process is assumed
+2 NEW DIR
+3 IF '$GET(CODE)
SET CODE=$$PRI^%ZOSV
+4 SET DIR=$$CHKNM^%ZISF($PIECE($GET(^XTV(8989.3,1,"DEV")),"^",CODE))
+5 IF $$OS^%ZOSV()["VMS"
Begin DoDot:1
+6 SET DIR=$PIECE(DIR,"]")_".print_queues]"
End DoDot:1
+7 IF '$TEST
Begin DoDot:1
+8 IF $EXTRACT(DIR,$LENGTH(DIR))'="/"
SET DIR=DIR_"/"
+9 SET DIR=DIR_"print_queues/"
End DoDot:1
+10 QUIT DIR
+11 ;
NEWJOB(DEVICE,DUZ) ;
+1 ;Creates a new entry in the PRINT QUEUE JOB file and creates a unique
+2 ;name for the print file.
+3 ;
+4 ;Input:
+5 ; DEVICE - ien of the device
+6 ; DUZ
+7 ;Output:
+8 ; Function value - returns the full path name of the host file for the print queue.
+9 ;
+10 NEW I,DATA,DIR,PQ,JOB
+11 IF '$GET(DEVICE)
SET POP=1
QUIT ""
+12 ;
+13 ;Get the name of the print queue
+14 SET PQ=$$GETPQ(DEVICE)
+15 IF PQ=""
SET POP=1
QUIT ""
+16 ;
+17 SET DATA(.01)=DEVICE
SET DATA(.02)=$$NOW^XLFDT
SET DATA(.04)=DUZ
SET DATA(.05)=PQ
SET DATA(.09)=$$PRI^%ZOSV
+18 SET JOB=$$ADD^ZISFM(3.52,,.DATA,.ERROR)
+19 if 'JOB
QUIT ""
+20 ;
+21 ;add the status
+22 SET DATA(.07)="O"
+23 ;add the filename -including the UCI and ien guarantees it to be unique
+24 SET DATA(.06)="PQ$"_$$UCI_"_"_JOB_".TXT"
+25 DO UPD^ZISFM(3.52,JOB,.DATA,.ERROR)
+26 QUIT $$DIR_DATA(.06)
+27 ;
STATUS(IO,STATUS,JOBID) ;Set the status of the PRINT QUEUE JOB
+1 ;Input:
+2 ; IO - file name, may include or not include the path, the ien is parsed out.
+3 ; STATUS (optional) status code. If ="" returns the current status.
+4 ; JOBID (optional) The job id. Should be passed in if the status is 'Q'ueued
+5 ;Output:
+6 ; function returns the current status
+7 ;
+8 NEW IEN,DATA,ERROR
+9 if '$LENGTH($GET(IO))
QUIT ""
+10 SET IEN=$$GETIEN(IO)
+11 if IEN=""
QUIT ""
+12 IF $GET(STATUS)=""
QUIT $PIECE($GET(^%ZIS(3.52,IEN,0)),"^",7)
+13 IF $LENGTH($GET(JOBID))
SET DATA(.08)=JOBID
+14 SET DATA(.07)=STATUS
+15 IF $EXTRACT(STATUS,1)="Q"
SET DATA(.03)=$$NOW^XLFDT
+16 IF STATUS="C"
IF $PIECE($GET(^%ZIS(3.52,IEN,0)),"^",7)="C"
SET DATA(.03)=$$NOW^XLFDT
+17 DO UPD^ZISFM(3.52,IEN,.DATA,.ERROR)
+18 QUIT STATUS
+19 ;
CLOSE(IO) ;Called from ^%ZISC. Closes the host file and passes it to the print queue
+1 ;
+2 NEW JOBID,STATUS
+3 ;
+4 SET STATUS=$$STATUS(IO)
+5 ;
+6 ;queued tasks are calling CLOSE logic twice, check for that
+7 IF (STATUS="Q")!(STATUS="P")!(STATUS="D")
QUIT
+8 ;
+9 IF '$$PRINT(IO,.JOBID)
SET STATUS="QE"
+10 IF '$TEST
SET STATUS="Q"
+11 DO STATUS(IO,STATUS,$GET(JOBID))
+12 QUIT
+13 ;
VQEXIST(Q) ; Tests if queue exists on this node - VMS
+1 ;Function returns 1 if the queue exists, 0 if it doesn't
+2 ;
+3 NEW CMD,RET
+4 SET CMD="PIPE Q = F$GETQUI(""DISPLAY_QUEUE"",""QUEUE_NAME"","""_Q_""")"
+5 SET CMD=CMD_" ; IF F$LENGTH(Q) .EQ. 0 THEN DEFINE/JOB ZIS$VAL 0 ; IF F$LENGTH(Q) .GT. 0 THEN DEFINE/JOB ZIS$VAL 1 "
+6 IF $ZF(-1,CMD)
+7 SET RET=$ZF("TRNLNM","ZIS$VAL","LNM$JOB")
+8 IF $ZF(-1,"DEASSIGN/JOB ZIS$VAL")
+9 QUIT +$GET(RET)
+10 ;
LQEXIST(Q) ; Tests if queue exists - LINUX
+1 NEW EOF,CMD,RESULTS,RET
+2 SET EOF=$ZU(68,40,1)
+3 SET CMD="lpstat -p "_$$REPLACE(Q,"$","'$'")_" 2> /dev/null"
+4 OPEN CMD:"qr"
USE CMD
READ RESULTS:2
CLOSE CMD
+5 IF RESULTS]""
SET RET=1
+6 SET EOF=$ZU(68,40,EOF)
+7 QUIT +$GET(RET)
+8 ;
PRINT(FILE,JOBID) ;Submits the file to be printed.
+1 ;Input:
+2 ; FILE - full file name, including path
+3 ;Output:
+4 ; function value - returns 1 on success, 0 on failure
+5 ; JOBID (pass by reference) on sucess may return the job id for the print job (not guaranteed)
+6 NEW OS,JOB
+7 SET JOB=FILE
+8 if '$$GETJOB(.JOB)
QUIT 0
+9 SET OS=$$OS^%ZOSV()
+10 IF OS["UNIX"
QUIT $$LPRINT(FILE,JOB("QUEUE"),.JOBID)
+11 IF OS["VMS"
QUIT $$VPRINT(FILE,JOB("QUEUE"),.JOBID)
+12 QUIT 0
+13 ;
LPRINT(FILE,Q,JOBID) ;
+1 NEW CMD,RESULT,EOF,RET
+2 SET RET=0
SET JOBID=""
+3 SET CMD="lpr -r -P"_Q_" "_FILE_" && echo success && lpq -P "_Q
+4 SET CMD=$$REPLACE(CMD,"$","'$'")
+5 SET EOF=$ZU(68,40,1)
+6 OPEN CMD:"QR":5
if '$TEST
QUIT
USE CMD
Begin DoDot:1
+7 READ RESULT:5
if '$TEST
QUIT
if RESULT=""
QUIT
+8 IF RESULT["success"
Begin DoDot:2
+9 NEW NAME
+10 SET NAME="PQ$JOB_"_$PIECE(FILE,"PQ$JOB_",2)
+11 SET RET=1
+12 FOR
READ RESULT:5
if '$TEST
QUIT
if RESULT=""
QUIT
IF RESULT[NAME
SET JOBID=$$INVERT^XLFSTR($PIECE($$INVERT^XLFSTR($$TRIM^XLFSTR($PIECE(RESULT,NAME),"R"))," "))
QUIT
End DoDot:2
End DoDot:1
CLOSE CMD
+13 SET EOF=$ZU(68,40,EOF)
+14 QUIT RET
+15 ;
VPRINT(FILE,Q,JOBID) ; VMS Print
+1 ;First determine the /PASS or /NOPASS parameter
+2 NEW CMD,PASS,NOPASS,RET
+3 SET RET=0
SET JOBID=""
+4 SET CMD="PIPE DESCR = F$GETQUI(""DISPLAY_QUEUE"",""QUEUE_DESCRIPTION"","""_Q_""")"
+5 SET CMD=CMD_" ; IF F$LOCATE( ""/NOPASS"",DESCR) .LT. F$LENGTH(DESCR) THEN DEFINE/JOB ZIS$VAL 1 "
+6 IF $ZF(-1,CMD)
+7 ;
+8 SET NOPASS=+$ZF("TRNLNM","ZIS$VAL","LNM$JOB")
+9 IF $ZF(-1,"DEASSIGN/JOB/NOLOG ZIS$VAL")
+10 SET PASS=$SELECT(NOPASS:"/NOPASS",1:"/PASS")
+11 ;
+12 ;Build the complete VMS PRINT command
+13 SET CMD="PIPE PRINT/DELETE"_PASS_"/NOIDENTITY/QUEUE="""_Q_""" "_FILE_" /PARAM=NOFLAG ; IF $STATUS THEN DEFINE/JOB ZIS$VAL &$ENTRY "
+14 ;
+15 IF $ZF(-1,CMD)=1
Begin DoDot:1
+16 SET JOBID=$ZF("TRNLNM","ZIS$VAL","LNM$JOB")
End DoDot:1
+17 IF JOBID'=""
IF $ZF(-1,"DEASSIGN/JOB/NOLOG ZIS$VAL")
+18 QUIT JOBID'=""
+19 ;
GETPQ(DEVICE) ;
+1 ;Given the ien of the DEVICE, it returns the name of the print queue,
+2 ;parsed from the $I or SECONDARY $I field of the DEVICE
+3 ;
+4 ;Returns "" on failure
+5 ;
+6 if '$GET(DEVICE)
QUIT ""
+7 NEW PQ
+8 ;
+9 ;get $I and parse out the name of the print queue
+10 if $$PRI^%ZOSV=2
SET PQ=$PIECE($GET(^%ZIS(1,DEVICE,2)),"^")
+11 if $GET(PQ)=""
SET PQ=$PIECE($GET(^%ZIS(1,DEVICE,0)),"^",2)
+12 ;
+13 ;$I field might look like this: DEV:[TEMP]HF_QUEUE.TXT - parse out thequeue name
+14 IF PQ[":"
SET PQ=$PIECE(PQ,":",2)
+15 SET PQ=$PIECE(PQ,".",1)
+16 IF PQ["]"
SET PQ=$PIECE(PQ,"]",2)
+17 ;
+18 QUIT PQ
+19 ;
REPLACE(STRING,SUB1,SUB2) ;
+1 NEW REPLACE
+2 SET REPLACE(SUB1)=SUB2
+3 QUIT $$REPLACE^XLFSTR(STRING,.REPLACE)
+4 ;
ID ;identifier logic on the PRINT QUEUES JOB file
+1 NEW ID,NAME,DATE
+2 SET NAME=$PIECE(^(0),"^",4)
+3 SET DATE=$PIECE(^(0),"^",2)
+4 IF NAME
SET NAME=$$LJ^XLFSTR($PIECE($GET(^VA(200,NAME,0)),"^"),18)_" "
+5 IF DATE
SET DATE=$$FMTE^XLFDT(DATE)
+6 SET ID=$EXTRACT(NAME,1,20)_" "_DATE
+7 DO EN^DDIOL(ID,"")
+8 QUIT
+9 ;
PURGE ;Purge of PRINT JOB QUEUES (file #3.52) and old host files that were queued. Also updates status on a regular basis.
+1 ;
+2 NEW DEVICE,STATUS,TIME,IEN,DIR,T1,T2,T3,NOW
+3 SET NOW=$$NOW^XLFDT
+4 SET ZTREQ=""
+5 ;
+6 ;set time parameters for this purge
+7 ;10 minutes ago
SET T1=$$FMADD^XLFDT(NOW,,-1)
+8 ;24 hours ago
SET T2=$$FMADD^XLFDT(NOW,-1)
+9 ;48 hours ago
SET T3=$$FMADD^XLFDT(NOW,-2)
+10 ;
+11 SET DIR=$$PRI^%ZOSV
+12 ;
+13 ;allow only one purge at a time on each system (primary, secondary)
LOCK +%ZIS(3.52,"PURGE JOB"_DIR):0
if '$TEST
QUIT
+14 ;
+15 ;look for queued jobs older than 10 minutes whose status can be changed to 'PRINTED & DELETED'
+16 SET STATUS="Q"
+17 SET DEVICE=0
+18 FOR
SET DEVICE=$ORDER(^%ZIS(3.52,"E",DIR,DEVICE))
if 'DEVICE
QUIT
Begin DoDot:1
+19 SET TIME=T2
FOR
SET TIME=$ORDER(^%ZIS(3.52,"E",DIR,DEVICE,STATUS,TIME))
if 'TIME
QUIT
if TIME>T1
QUIT
Begin DoDot:2
+20 SET IEN=0
FOR
SET IEN=$ORDER(^%ZIS(3.52,"E",DIR,DEVICE,STATUS,TIME,IEN))
if 'IEN
QUIT
Begin DoDot:3
+21 NEW JOB
SET JOB=IEN
+22 IF '$$GETJOB(.JOB)
QUIT
+23 ;if the host file is gone, it has been printed
+24 IF $$FEXIST(JOB("FILE"))
DO STATUS(JOB("FILE"),"D")
End DoDot:3
End DoDot:2
End DoDot:1
+25 ;
+26 ;delete host files older than 24 hours
+27 SET DEVICE=0
+28 FOR
SET DEVICE=$ORDER(^%ZIS(3.52,"E",DIR,DEVICE))
if 'DEVICE
QUIT
Begin DoDot:1
+29 if $$STOPPED(DEVICE)
QUIT
+30 SET STATUS=""
+31 FOR
SET STATUS=$ORDER(^%ZIS(3.52,"E",DIR,DEVICE,STATUS))
if STATUS=""
QUIT
IF STATUS'="P"
IF STATUS'="D"
Begin DoDot:2
+32 SET TIME=0
+33 FOR
SET TIME=$ORDER(^%ZIS(3.52,"E",DIR,DEVICE,STATUS,TIME))
if 'TIME
QUIT
if TIME>T2
QUIT
Begin DoDot:3
+34 SET IEN=0
FOR
SET IEN=$ORDER(^%ZIS(3.52,"E",DIR,DEVICE,STATUS,TIME,IEN))
if 'IEN
QUIT
Begin DoDot:4
+35 NEW JOB
SET JOB=IEN
+36 IF '$$GETJOB(.JOB)
KILL ^%ZIS(3.52,"E",DIR,DEVICE,STATUS,TIME,IEN)
QUIT
+37 ;delete the host file if it exists and change the status
+38 IF $$FEXIST(JOB("FILE"))
DO FDELETE(JOB("FILE"))
DO STATUS(JOB("FILE"),"D")
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+39 ;
+40 ;delete jobs (file #3.52) older than 48 hours
+41 SET DEVICE=0
+42 FOR
SET DEVICE=$ORDER(^%ZIS(3.52,"E",DIR,DEVICE))
if 'DEVICE
QUIT
Begin DoDot:1
+43 if $$STOPPED(DEVICE)
QUIT
+44 SET STATUS=""
FOR
SET STATUS=$ORDER(^%ZIS(3.52,"E",DIR,DEVICE,STATUS))
if STATUS=""
QUIT
Begin DoDot:2
+45 SET TIME=0
FOR
SET TIME=$ORDER(^%ZIS(3.52,"E",DIR,DEVICE,STATUS,TIME))
if 'TIME
QUIT
if TIME>T3
QUIT
Begin DoDot:3
+46 SET IEN=0
FOR
SET IEN=$ORDER(^%ZIS(3.52,"E",DIR,DEVICE,STATUS,TIME,IEN))
if 'IEN
QUIT
Begin DoDot:4
+47 NEW JOB
SET JOB=IEN
+48 IF '$$GETJOB(.JOB)
KILL ^%ZIS(3.52,"E",DIR,DEVICE,STATUS,TIME,IEN)
QUIT
+49 ;delete the job entry (file #3.52)
+50 DO JDELETE(IEN)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+51 ;
+52 LOCK -%ZIS(3.52,"PURGE JOB"_DIR)
+53 QUIT
+54 ;
GETJOB(JOB) ;returns job info (file 3.52). Input JOB=ien OR the name of the host file, returns .JOB array with job's fields
+1 NEW NODE,FILE,DIR,IEN
+2 SET IEN=$GET(JOB)
+3 IF 'IEN
IF $LENGTH(IEN)
SET IEN=$$GETIEN(IEN)
+4 if 'IEN
QUIT ""
+5 SET JOB("IEN")=IEN
+6 SET NODE=$GET(^%ZIS(3.52,IEN,0))
+7 if NODE=""
QUIT 0
+8 SET JOB("QUEUE")=$PIECE(NODE,"^",5)
+9 SET JOB("ID")=$PIECE(NODE,"^",8)
+10 SET FILE=$PIECE(NODE,"^",6)
+11 SET DIR=$PIECE(NODE,"^",9)
+12 SET DIR=$$DIR(DIR)
+13 SET FILE=DIR_FILE
+14 SET JOB("FILE")=FILE
+15 QUIT 1
+16 ;
STOPPED(DEVICE) ;was purging suspended for this device?
+1 NEW RET
+2 SET RET=$PIECE($GET(^%ZIS(1,+DEVICE,0)),"^",13)
+3 IF RET="N"
QUIT 1
+4 QUIT 0
+5 ;
FEXIST(FILE) ;returns 1 if the file exists, 0 otherwise
+1 ;
+2 NEW OS
SET OS=$$OS^%ZOSV()
+3 IF OS["UNIX"
QUIT $$LFEXIST(FILE)
+4 IF '$TEST
IF OS["VMS"
QUIT $$VFEXIST(FILE)
+5 QUIT 0
+6 ;
VFEXIST(FILE) ;checks file's existance - VMS
+1 NEW CMD,RET
+2 SET CMD="PIPE F = F$SEARCH("""_FILE_""")"
+3 SET CMD=CMD_" ; IF F$LENGTH(F) .EQ. 0 THEN DEFINE/JOB ZIS$VAL 0 ; IF F$LENGTH(F) .GT. 0 THEN DEFINE/JOB ZIS$VAL 1 "
+4 IF $ZF(-1,CMD)
+5 SET RET=$ZF("TRNLNM","ZIS$VAL","LNM$JOB")
+6 IF $ZF(-1,"DEASSIGN/JOB ZIS$VAL")
+7 QUIT +$GET(RET)
+8 ;
LFEXIST(FILE) ;checks file's existance - Linux,Unix
+1 NEW CMD
+2 SET CMD="[ -f "_$$REPLACE(FILE,"$","'$'")_" ]"
+3 QUIT '$ZF(-1,CMD)
+4 ;
FDELETE(FILE) ;delete file
+1 NEW OS
SET OS=$$OS^%ZOSV()
+2 IF OS["UNIX"
DO LFDELETE(FILE)
+3 IF '$TEST
IF OS["VMS"
DO VFDELETE(FILE)
+4 QUIT
+5 ;
VFDELETE(FILE) ;delete file - VMS
+1 NEW CMD
+2 IF FILE'[";"
SET FILE=FILE_";*"
+3 SET CMD="DELETE "_FILE
+4 IF $ZF(-1,CMD)
+5 QUIT
+6 ;
LFDELETE(FILE) ;delete file - Linux,Unix
+1 NEW CMD
+2 SET CMD="rm -f "_$$REPLACE(FILE,"$","'$'")
+3 IF $ZF(-1,CMD)
+4 QUIT
+5 ;
JDELETE(IEN) ;delete the job, file #3.52
+1 DO DELETE^ZISFM(3.52,IEN)
+2 QUIT
+3 ;
DEQUEUE(JOBID,QUEUE) ;Remove a job from a queue
+1 NEW OS
SET OS=$$OS^%ZOSV()
+2 IF OS["UNIX"
QUIT $$LDEQUEUE(JOBID,QUEUE)
+3 IF '$TEST
IF OS["VMS"
QUIT $$VDEQUEUE(JOBID,QUEUE)
+4 QUIT
+5 ;
VDEQUEUE(JOBID,QUEUE) ;Remove a job from a queue - VMS
+1 IF $ZF(-1,"DELETE /ENTRY="_JOBID_" "_QUEUE)
+2 QUIT
+3 ;
LDEQUEUE(JOBID,QUEUE) ;Remove a job from a queue - Linux, Unix
+1 NEW CMD
+2 SET CMD="lprm -P "_$$REPLACE(QUEUE,"$","'$'")_" "_JOBID
+3 IF $ZF(-1,CMD)
+4 QUIT
UCI() ;return the UCI
+1 NEW Y
+2 XECUTE ^%ZOSF("UCI")
+3 QUIT $PIECE(Y,",")
+4 ;
GETIEN(FILE) ;given the file name, parses out the ien and returns it
+1 QUIT $PIECE($PIECE(FILE,"PQ$"_$$UCI_"_",2),".TXT")
+2 ;
+3 ;
+4 ;
+5 ;
