Routine: PRCHUTL1

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

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

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

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  Mar 13, 2025@21:16:14                                                                                                                                                                                                    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

PRCHUTL1.m