- PRCHQUE ;WISC/CLH,ID/RSD/TKW/REW/BGJ-QUE PRINTOUTS ; [7/2/98 3:20pm]
- ;;5.1;IFCAP;**14**;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- ; INPUT TO PRCHQUE:
- ;
- ; D0,D1
- ; PRCHQ=ROUTINE
- ; PRCHQ("DEST")=DESTINATION
- ; PRC("SITE")=STATION #
- ; PRC("SST")=SUBSTATION #
- ; DUZ
- ; PRCHQ("DEST2")=INDICATOR THAT ROUTES PRINT OF RECEIVING
- ; REPORT TO FISCAL
- ;
- D CLNUP
- S (ZTRTN,ZTDESC)=PRCHQ
- S:$D(D0) PRCHXXD0=D0
- S:$D(D1) PRCHXXD1=D1
- I PRCHQ["PRCPRIB" D
- . N PRCPRIB
- . S (PRCPRIB,ZTSAVE("PRCPRIB"))=D0
- . Q
- S:$D(PPMFLG) ZTSAVE("NOPRINT")=""
- K IOP,ZTSK
- S IOP=""
- S X=""
- I $D(PRCHQ("DEST2")) S X=PRCHQ("DEST2")
- I X=""&($D(PRCHQ("DEST"))) S X=PRCHQ("DEST")
- ;Check for substation
- I $G(PRC("SST"))]"" D SUBST Q
- I $D(^PRC(411,PRC("SITE"),2)) D GETIOP(PRC("SITE"))
- ;Check for Fiscal Stack
- 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
- QDEV G Q:$G(PRCHIO)=IO(0)
- I IOP'="" D G:'POP Q
- . S %ZIS=$S(IOP=" ":"",1:"NQ")
- . D ^%ZIS
- . Q:'POP
- . W $C(7),!!,">>>> ",X," IS NOT A VALID PRINTER, POSSIBLY FROM ",PRC("SITE"),"'S SITE PARAMETER FILE ",!!
- . Q
- ;
- SDEV S %ZIS("B")=""
- ;
- SDEV1 S %ZIS("A")="QUEUE ON DEVICE: "
- S %ZIS="NQ"
- S NOZTDTH=""
- K IOP
- D ^%ZIS
- G:POP EXIT
- S IOP=ION_";"_IOST_";"_IOM_";"_IOSL
- I IO=IO(0) D G EXIT
- . D ^%ZIS
- . U IO
- . D @ZTRTN
- . D ^%ZISC
- . Q
- ;
- Q S U="^"
- S:$D(PRCHXXD0) D0=PRCHXXD0,ZTSAVE("D0")=""
- S:$D(PRCHXXD1) D1=PRCHXXD1,ZTSAVE("D1")=""
- S ZTSAVE("U")=""
- S:$D(PRCHQ("DEST")) ZTSAVE("PRCHQ(""DEST"")")=""
- S:$D(PRCHFPT) ZTSAVE("PRCHFPT")=""
- S:$D(DEST) ZTSAVE("DEST")=""
- S:$D(PRC("SITE")) ZTSAVE("PRC(""SITE"")")=""
- S:$D(PRCHREPR) ZTSAVE("PRCHREPR")=""
- I ZTRTN="EN2^PRCHRPT9"!(ZTRTN="EN2^PRCHRPL") D
- . D PP3
- . S ZTDTH=""
- . Q
- E D
- . D:ZTRTN="STQUE^PRCHPNT1" PP2
- . S:'$D(NOZTDTH) ZTDTH=$H
- . ; Per SAAN for P69 -- allow scheduling for user selected devices.
- . Q
- ;
- I $G(PRCHIO)=IO(0)!($G(PRCHIO)=" ") D
- . D @ZTRTN,^%ZISC:$G(PRCHIO)=" "
- . ;Specify device 0;##;### TO RUN PRINT PROGRAMS THAT
- . ;NORMALLY RUN IN THE BACKGROUND IN THE FOREGROUND.
- . Q
- E D ^%ZTLOAD,^%ZISC
- ;
- EXIT K IOP,PRCHQ,XMAPHOST,NOZTDTH
- ;
- CLNUP K ZTRTN,ZTUCI,ZTDTH,ZTSAVE,ZTDESC,ZTSK,ZTSKT,ZTCPU,ZTI,ZTJOB,ZTM1
- K ZTM2,ZTMAST,ZTMGR,ZTNLG,ZTOS,ZTPD,ZTPO,ZTPROD,ZTPT,ZTRET,ZTSIZ
- K ZTU1,ZTVOL,ZTXMB,PRCHXXD0,PRCHXXD1
- Q
- ;
- SUBST ;Substation is being used
- N DONE
- S DONE=0
- I $D(^PRC(411,PRC("SST"),2)) D Q:DONE
- . D GETIOP(PRC("SST"))
- . ;Check for Fiscal Stack
- . 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
- I IOP="",$D(^PRC(411,PRC("SITE"),2)) D Q:DONE
- . D GETIOP(PRC("SITE"))
- . ;Check for Fiscal Stack
- . 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
- ;Check field 61 in file 411 to see if user should be prompted for device
- I +$P($G(^PRC(411,PRC("SITE"),0)),U,26) D Q
- . S %ZIS("B")=IOP
- . D SDEV1
- . Q
- D QDEV
- Q
- ;
- GETIOP(DA) ;
- I X]"" D
- . S IOP=$O(^PRC(411,DA,2,"AC",X,0))
- . I IOP=""&(X["SPOOL"!(X["LTA")!$D(^%ZIS(1,"B",X))!(X?1N.N)!(X=" ")) S IOP=X
- . Q
- Q
- ;
- PP2 S ZTSAVE("PRCH0")=""
- S ZTSAVE("PRCH1")=""
- S ZTSAVE("PRCH")=""
- S ZTSAVE("PRCHV")=""
- S ZTSAVE("PRCHP")=""
- S ZTSAVE("PRCHJ")=""
- S ZTSAVE("N")=""
- S ZTSAVE("^TMP($J,")=""
- Q
- ;
- PP3 ;SETUP FOR PRINTING PL100-322 REPORT
- S ZTSAVE("FR")=""
- S ZTSAVE("TO")=""
- S ZTSAVE("PRCHNULL")=""
- S ZTSAVE("PRCHDET")=""
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHQUE 3788 printed Jan 18, 2025@03:11:16 Page 2
- PRCHQUE ;WISC/CLH,ID/RSD/TKW/REW/BGJ-QUE PRINTOUTS ; [7/2/98 3:20pm]
- +1 ;;5.1;IFCAP;**14**;Oct 20, 2000
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- +4 ; INPUT TO PRCHQUE:
- +5 ;
- +6 ; D0,D1
- +7 ; PRCHQ=ROUTINE
- +8 ; PRCHQ("DEST")=DESTINATION
- +9 ; PRC("SITE")=STATION #
- +10 ; PRC("SST")=SUBSTATION #
- +11 ; DUZ
- +12 ; PRCHQ("DEST2")=INDICATOR THAT ROUTES PRINT OF RECEIVING
- +13 ; REPORT TO FISCAL
- +14 ;
- +15 DO CLNUP
- +16 SET (ZTRTN,ZTDESC)=PRCHQ
- +17 if $DATA(D0)
- SET PRCHXXD0=D0
- +18 if $DATA(D1)
- SET PRCHXXD1=D1
- +19 IF PRCHQ["PRCPRIB"
- Begin DoDot:1
- +20 NEW PRCPRIB
- +21 SET (PRCPRIB,ZTSAVE("PRCPRIB"))=D0
- +22 QUIT
- End DoDot:1
- +23 if $DATA(PPMFLG)
- SET ZTSAVE("NOPRINT")=""
- +24 KILL IOP,ZTSK
- +25 SET IOP=""
- +26 SET X=""
- +27 IF $DATA(PRCHQ("DEST2"))
- SET X=PRCHQ("DEST2")
- +28 IF X=""&($DATA(PRCHQ("DEST")))
- SET X=PRCHQ("DEST")
- +29 ;Check for substation
- +30 IF $GET(PRC("SST"))]""
- DO SUBST
- QUIT
- +31 IF $DATA(^PRC(411,PRC("SITE"),2))
- DO GETIOP(PRC("SITE"))
- +32 ;Check for Fiscal Stack
- +33 IF IOP'=""&(X'="IFP")&(X'="IFR")&(X="F"!(X="FR"))
- SET DA=$ORDER(^PRC(411,PRC("SITE"),2,"AC",X,IOP,0))
- IF $PIECE($GET(^PRC(411,PRC("SITE"),2,DA,0)),U,3)
- DO ^PRCFPR
- QUIT
- QDEV if $GET(PRCHIO)=IO(0)
- GOTO Q
- +1 IF IOP'=""
- Begin DoDot:1
- +2 SET %ZIS=$SELECT(IOP=" ":"",1:"NQ")
- +3 DO ^%ZIS
- +4 if 'POP
- QUIT
- +5 WRITE $CHAR(7),!!,">>>> ",X," IS NOT A VALID PRINTER, POSSIBLY FROM ",PRC("SITE"),"'S SITE PARAMETER FILE ",!!
- +6 QUIT
- End DoDot:1
- if 'POP
- GOTO Q
- +7 ;
- SDEV SET %ZIS("B")=""
- +1 ;
- SDEV1 SET %ZIS("A")="QUEUE ON DEVICE: "
- +1 SET %ZIS="NQ"
- +2 SET NOZTDTH=""
- +3 KILL IOP
- +4 DO ^%ZIS
- +5 if POP
- GOTO EXIT
- +6 SET IOP=ION_";"_IOST_";"_IOM_";"_IOSL
- +7 IF IO=IO(0)
- Begin DoDot:1
- +8 DO ^%ZIS
- +9 USE IO
- +10 DO @ZTRTN
- +11 DO ^%ZISC
- +12 QUIT
- End DoDot:1
- GOTO EXIT
- +13 ;
- Q SET U="^"
- +1 if $DATA(PRCHXXD0)
- SET D0=PRCHXXD0
- SET ZTSAVE("D0")=""
- +2 if $DATA(PRCHXXD1)
- SET D1=PRCHXXD1
- SET ZTSAVE("D1")=""
- +3 SET ZTSAVE("U")=""
- +4 if $DATA(PRCHQ("DEST"))
- SET ZTSAVE("PRCHQ(""DEST"")")=""
- +5 if $DATA(PRCHFPT)
- SET ZTSAVE("PRCHFPT")=""
- +6 if $DATA(DEST)
- SET ZTSAVE("DEST")=""
- +7 if $DATA(PRC("SITE"))
- SET ZTSAVE("PRC(""SITE"")")=""
- +8 if $DATA(PRCHREPR)
- SET ZTSAVE("PRCHREPR")=""
- +9 IF ZTRTN="EN2^PRCHRPT9"!(ZTRTN="EN2^PRCHRPL")
- Begin DoDot:1
- +10 DO PP3
- +11 SET ZTDTH=""
- +12 QUIT
- End DoDot:1
- +13 IF '$TEST
- Begin DoDot:1
- +14 if ZTRTN="STQUE^PRCHPNT1"
- DO PP2
- +15 if '$DATA(NOZTDTH)
- SET ZTDTH=$HOROLOG
- +16 ; Per SAAN for P69 -- allow scheduling for user selected devices.
- +17 QUIT
- End DoDot:1
- +18 ;
- +19 IF $GET(PRCHIO)=IO(0)!($GET(PRCHIO)=" ")
- Begin DoDot:1
- +20 DO @ZTRTN
- if $GET(PRCHIO)=" "
- DO ^%ZISC
- +21 ;Specify device 0;##;### TO RUN PRINT PROGRAMS THAT
- +22 ;NORMALLY RUN IN THE BACKGROUND IN THE FOREGROUND.
- +23 QUIT
- End DoDot:1
- +24 IF '$TEST
- DO ^%ZTLOAD
- DO ^%ZISC
- +25 ;
- EXIT KILL IOP,PRCHQ,XMAPHOST,NOZTDTH
- +1 ;
- CLNUP KILL ZTRTN,ZTUCI,ZTDTH,ZTSAVE,ZTDESC,ZTSK,ZTSKT,ZTCPU,ZTI,ZTJOB,ZTM1
- +1 KILL ZTM2,ZTMAST,ZTMGR,ZTNLG,ZTOS,ZTPD,ZTPO,ZTPROD,ZTPT,ZTRET,ZTSIZ
- +2 KILL ZTU1,ZTVOL,ZTXMB,PRCHXXD0,PRCHXXD1
- +3 QUIT
- +4 ;
- SUBST ;Substation is being used
- +1 NEW DONE
- +2 SET DONE=0
- +3 IF $DATA(^PRC(411,PRC("SST"),2))
- Begin DoDot:1
- +4 DO GETIOP(PRC("SST"))
- +5 ;Check for Fiscal Stack
- +6 IF IOP'=""&(X'="IFP")&(X'="IFR")&(X="F"!(X="FR"))
- SET DA=$ORDER(^PRC(411,PRC("SST"),2,"AC",X,IOP,0))
- IF $PIECE($GET(^PRC(411,PRC("SST"),2,DA,0)),U,3)
- DO ^PRCFPR
- SET DONE=1
- End DoDot:1
- if DONE
- QUIT
- +7 IF IOP=""
- IF $DATA(^PRC(411,PRC("SITE"),2))
- Begin DoDot:1
- +8 DO GETIOP(PRC("SITE"))
- +9 ;Check for Fiscal Stack
- +10 IF IOP'=""&(X'="IFP")&(X'="IFR")&(X="F"!(X="FR"))
- SET DA=$ORDER(^PRC(411,PRC("SITE"),2,"AC",X,IOP,0))
- IF $PIECE($GET(^PRC(411,PRC("SITE"),2,DA,0)),U,3)
- DO ^PRCFPR
- SET DONE=1
- End DoDot:1
- if DONE
- QUIT
- +11 ;Check field 61 in file 411 to see if user should be prompted for device
- +12 IF +$PIECE($GET(^PRC(411,PRC("SITE"),0)),U,26)
- Begin DoDot:1
- +13 SET %ZIS("B")=IOP
- +14 DO SDEV1
- +15 QUIT
- End DoDot:1
- QUIT
- +16 DO QDEV
- +17 QUIT
- +18 ;
- GETIOP(DA) ;
- +1 IF X]""
- Begin DoDot:1
- +2 SET IOP=$ORDER(^PRC(411,DA,2,"AC",X,0))
- +3 IF IOP=""&(X["SPOOL"!(X["LTA")!$DATA(^%ZIS(1,"B",X))!(X?1N.N)!(X=" "))
- SET IOP=X
- +4 QUIT
- End DoDot:1
- +5 QUIT
- +6 ;
- PP2 SET ZTSAVE("PRCH0")=""
- +1 SET ZTSAVE("PRCH1")=""
- +2 SET ZTSAVE("PRCH")=""
- +3 SET ZTSAVE("PRCHV")=""
- +4 SET ZTSAVE("PRCHP")=""
- +5 SET ZTSAVE("PRCHJ")=""
- +6 SET ZTSAVE("N")=""
- +7 SET ZTSAVE("^TMP($J,")=""
- +8 QUIT
- +9 ;
- PP3 ;SETUP FOR PRINTING PL100-322 REPORT
- +1 SET ZTSAVE("FR")=""
- +2 SET ZTSAVE("TO")=""
- +3 SET ZTSAVE("PRCHNULL")=""
- +4 SET ZTSAVE("PRCHDET")=""
- +5 QUIT