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

PRCHQUE.m

Go to the documentation of this file.
  1. PRCHQUE ;WISC/CLH,ID/RSD/TKW/REW/BGJ-QUE PRINTOUTS ; [7/2/98 3:20pm]
  1. ;;5.1;IFCAP;**14**;Oct 20, 2000
  1. ;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. ; INPUT TO PRCHQUE:
  1. ;
  1. ; D0,D1
  1. ; PRCHQ=ROUTINE
  1. ; PRCHQ("DEST")=DESTINATION
  1. ; PRC("SITE")=STATION #
  1. ; PRC("SST")=SUBSTATION #
  1. ; DUZ
  1. ; PRCHQ("DEST2")=INDICATOR THAT ROUTES PRINT OF RECEIVING
  1. ; REPORT TO FISCAL
  1. ;
  1. D CLNUP
  1. S (ZTRTN,ZTDESC)=PRCHQ
  1. S:$D(D0) PRCHXXD0=D0
  1. S:$D(D1) PRCHXXD1=D1
  1. I PRCHQ["PRCPRIB" D
  1. . N PRCPRIB
  1. . S (PRCPRIB,ZTSAVE("PRCPRIB"))=D0
  1. . Q
  1. S:$D(PPMFLG) ZTSAVE("NOPRINT")=""
  1. K IOP,ZTSK
  1. S IOP=""
  1. S X=""
  1. I $D(PRCHQ("DEST2")) S X=PRCHQ("DEST2")
  1. I X=""&($D(PRCHQ("DEST"))) S X=PRCHQ("DEST")
  1. ;Check for substation
  1. I $G(PRC("SST"))]"" D SUBST Q
  1. I $D(^PRC(411,PRC("SITE"),2)) D GETIOP(PRC("SITE"))
  1. ;Check for Fiscal Stack
  1. I IOP'=""&(X'="IFP")&(X'="IFR")&(X="F"!(X="FR")) S DA=$O(^PRC(411,PRC("SITE"),2,"AC",X,IOP,0)) I $P($G(^PRC(411,PRC("SITE"),2,DA,0)),U,3) D ^PRCFPR Q
  1. QDEV G Q:$G(PRCHIO)=IO(0)
  1. I IOP'="" D G:'POP Q
  1. . S %ZIS=$S(IOP=" ":"",1:"NQ")
  1. . D ^%ZIS
  1. . Q:'POP
  1. . W $C(7),!!,">>>> ",X," IS NOT A VALID PRINTER, POSSIBLY FROM ",PRC("SITE"),"'S SITE PARAMETER FILE ",!!
  1. . Q
  1. ;
  1. SDEV S %ZIS("B")=""
  1. ;
  1. SDEV1 S %ZIS("A")="QUEUE ON DEVICE: "
  1. S %ZIS="NQ"
  1. S NOZTDTH=""
  1. K IOP
  1. D ^%ZIS
  1. G:POP EXIT
  1. S IOP=ION_";"_IOST_";"_IOM_";"_IOSL
  1. I IO=IO(0) D G EXIT
  1. . D ^%ZIS
  1. . U IO
  1. . D @ZTRTN
  1. . D ^%ZISC
  1. . Q
  1. ;
  1. Q S U="^"
  1. S:$D(PRCHXXD0) D0=PRCHXXD0,ZTSAVE("D0")=""
  1. S:$D(PRCHXXD1) D1=PRCHXXD1,ZTSAVE("D1")=""
  1. S ZTSAVE("U")=""
  1. S:$D(PRCHQ("DEST")) ZTSAVE("PRCHQ(""DEST"")")=""
  1. S:$D(PRCHFPT) ZTSAVE("PRCHFPT")=""
  1. S:$D(DEST) ZTSAVE("DEST")=""
  1. S:$D(PRC("SITE")) ZTSAVE("PRC(""SITE"")")=""
  1. S:$D(PRCHREPR) ZTSAVE("PRCHREPR")=""
  1. I ZTRTN="EN2^PRCHRPT9"!(ZTRTN="EN2^PRCHRPL") D
  1. . D PP3
  1. . S ZTDTH=""
  1. . Q
  1. E D
  1. . D:ZTRTN="STQUE^PRCHPNT1" PP2
  1. . S:'$D(NOZTDTH) ZTDTH=$H
  1. . ; Per SAAN for P69 -- allow scheduling for user selected devices.
  1. . Q
  1. ;
  1. I $G(PRCHIO)=IO(0)!($G(PRCHIO)=" ") D
  1. . D @ZTRTN,^%ZISC:$G(PRCHIO)=" "
  1. . ;Specify device 0;##;### TO RUN PRINT PROGRAMS THAT
  1. . ;NORMALLY RUN IN THE BACKGROUND IN THE FOREGROUND.
  1. . Q
  1. E D ^%ZTLOAD,^%ZISC
  1. ;
  1. EXIT K IOP,PRCHQ,XMAPHOST,NOZTDTH
  1. ;
  1. CLNUP K ZTRTN,ZTUCI,ZTDTH,ZTSAVE,ZTDESC,ZTSK,ZTSKT,ZTCPU,ZTI,ZTJOB,ZTM1
  1. K ZTM2,ZTMAST,ZTMGR,ZTNLG,ZTOS,ZTPD,ZTPO,ZTPROD,ZTPT,ZTRET,ZTSIZ
  1. K ZTU1,ZTVOL,ZTXMB,PRCHXXD0,PRCHXXD1
  1. Q
  1. ;
  1. SUBST ;Substation is being used
  1. N DONE
  1. S DONE=0
  1. I $D(^PRC(411,PRC("SST"),2)) D Q:DONE
  1. . D GETIOP(PRC("SST"))
  1. . ;Check for Fiscal Stack
  1. . I IOP'=""&(X'="IFP")&(X'="IFR")&(X="F"!(X="FR")) S DA=$O(^PRC(411,PRC("SST"),2,"AC",X,IOP,0)) I $P($G(^PRC(411,PRC("SST"),2,DA,0)),U,3) D ^PRCFPR S DONE=1
  1. I IOP="",$D(^PRC(411,PRC("SITE"),2)) D Q:DONE
  1. . D GETIOP(PRC("SITE"))
  1. . ;Check for Fiscal Stack
  1. . I IOP'=""&(X'="IFP")&(X'="IFR")&(X="F"!(X="FR")) S DA=$O(^PRC(411,PRC("SITE"),2,"AC",X,IOP,0)) I $P($G(^PRC(411,PRC("SITE"),2,DA,0)),U,3) D ^PRCFPR S DONE=1
  1. ;Check field 61 in file 411 to see if user should be prompted for device
  1. I +$P($G(^PRC(411,PRC("SITE"),0)),U,26) D Q
  1. . S %ZIS("B")=IOP
  1. . D SDEV1
  1. . Q
  1. D QDEV
  1. Q
  1. ;
  1. GETIOP(DA) ;
  1. I X]"" D
  1. . S IOP=$O(^PRC(411,DA,2,"AC",X,0))
  1. . I IOP=""&(X["SPOOL"!(X["LTA")!$D(^%ZIS(1,"B",X))!(X?1N.N)!(X=" ")) S IOP=X
  1. . Q
  1. Q
  1. ;
  1. PP2 S ZTSAVE("PRCH0")=""
  1. S ZTSAVE("PRCH1")=""
  1. S ZTSAVE("PRCH")=""
  1. S ZTSAVE("PRCHV")=""
  1. S ZTSAVE("PRCHP")=""
  1. S ZTSAVE("PRCHJ")=""
  1. S ZTSAVE("N")=""
  1. S ZTSAVE("^TMP($J,")=""
  1. Q
  1. ;
  1. PP3 ;SETUP FOR PRINTING PL100-322 REPORT
  1. S ZTSAVE("FR")=""
  1. S ZTSAVE("TO")=""
  1. S ZTSAVE("PRCHNULL")=""
  1. S ZTSAVE("PRCHDET")=""
  1. Q