Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ZISPQ

ZISPQ.m

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