PRCHUTL1 ;WISC/AKS-UTILITY ROUTINES FOR SUPPLY SYSTEM ;1/26/93 12:47
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
;
ENRDAT ; ROUTINE ALLOWING ENTRY OF A DATE FOR PRINTING, ETC. (DEFAULTS TO NOW)
W !!,"Enter date (and time, if not NOW) to "_M S %DT="AETR",%DT("A")="DATE: NOW//" D ^%DT K %DT
S:X="" X="NOW" S:X="NOW" Y=$H,PRCHPDAT=$H S:Y=-1 X="^" Q:(X="NOW")!(X["^")
I +$P(Y,".",2)'>0 W $C(7),!,"You must enter the time as well as the date to print the report" G ENRDAT
S PRCHPDAT=Y
Q
;
SELDEV ; SELECT DEVICE FOR QUED PRINTING
D ENK31 W ! K %ZIS,IOP S %ZIS="Q",IOP="Q",%ZIS("B")="" D ^%ZIS Q:POP
S IOP=ION_";"_IOST_";"_IOM_";"_IOSL I IO=IO(0) D ^%ZIS U IO D @ZTRTN D ^%ZISC
Q
;
ENK3 ; KILL VARIABLES USED BY UNIVERSAL TASK MANAGER AND CLOSE PRINTER
D ^%ZISC K ZTRTN
ENK31 K ZTUCI,ZTDTH,ZTSAVE,ZTDESC,ZTIO,ZTSK,ZTSKT,ZTCPU,ZTI,ZTJOB,ZTM1,ZTM2,ZTMAST,ZTMGR,ZTNLG,ZTOS,ZTPD,ZTPO,ZTPROD,ZTPT,ZTRET,ZTSIZ,ZTU1,ZTVOL,ZTXMB
Q
;
SQUE(RTN) ;PRINT MESSAGE DENOTING QUEUED JOB HAS BEEN REQUESTED TO STOP
;RTN is the routine name that called this line tag
S:'$D(RTN)!(RTN="") RTN="NOT GIVEN"
Q "*** USER-REQUESTED STOP *** ROUTINE - "_RTN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHUTL1 1222 printed Dec 13, 2024@02:11:26 Page 2
PRCHUTL1 ;WISC/AKS-UTILITY ROUTINES FOR SUPPLY SYSTEM ;1/26/93 12:47
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;
ENRDAT ; ROUTINE ALLOWING ENTRY OF A DATE FOR PRINTING, ETC. (DEFAULTS TO NOW)
+1 WRITE !!,"Enter date (and time, if not NOW) to "_M
SET %DT="AETR"
SET %DT("A")="DATE: NOW//"
DO ^%DT
KILL %DT
+2 if X=""
SET X="NOW"
if X="NOW"
SET Y=$HOROLOG
SET PRCHPDAT=$HOROLOG
if Y=-1
SET X="^"
if (X="NOW")!(X["^")
QUIT
+3 IF +$PIECE(Y,".",2)'>0
WRITE $CHAR(7),!,"You must enter the time as well as the date to print the report"
GOTO ENRDAT
+4 SET PRCHPDAT=Y
+5 QUIT
+6 ;
SELDEV ; SELECT DEVICE FOR QUED PRINTING
+1 DO ENK31
WRITE !
KILL %ZIS,IOP
SET %ZIS="Q"
SET IOP="Q"
SET %ZIS("B")=""
DO ^%ZIS
if POP
QUIT
+2 SET IOP=ION_";"_IOST_";"_IOM_";"_IOSL
IF IO=IO(0)
DO ^%ZIS
USE IO
DO @ZTRTN
DO ^%ZISC
+3 QUIT
+4 ;
ENK3 ; KILL VARIABLES USED BY UNIVERSAL TASK MANAGER AND CLOSE PRINTER
+1 DO ^%ZISC
KILL ZTRTN
ENK31 KILL ZTUCI,ZTDTH,ZTSAVE,ZTDESC,ZTIO,ZTSK,ZTSKT,ZTCPU,ZTI,ZTJOB,ZTM1,ZTM2,ZTMAST,ZTMGR,ZTNLG,ZTOS,ZTPD,ZTPO,ZTPROD,ZTPT,ZTRET,ZTSIZ,ZTU1,ZTVOL,ZTXMB
+1 QUIT
+2 ;
SQUE(RTN) ;PRINT MESSAGE DENOTING QUEUED JOB HAS BEEN REQUESTED TO STOP
+1 ;RTN is the routine name that called this line tag
+2 if '$DATA(RTN)!(RTN="")
SET RTN="NOT GIVEN"
+3 QUIT "*** USER-REQUESTED STOP *** ROUTINE - "_RTN