PRCBP ;WISC/CTB-PRINT OPTIONS FOR PRCB ;10/31/01 12:50pm
V ;;5.1;IFCAP;**3,43,139**;Oct 20, 2000;Build 16
;Per VHA Directive 2004-038, this routine should not be modified.
SE W !!,$C(7),"ENTRY TO THIS ROUTINE IS ONLY PERMITTED THROUGH THE APPROPRIATE",!,"MENU OR DRIVER" Q
OUT K %,%Y,DIJ,DP,IOX,IOY,POP,PRCB,PRCF,PRC("CP"),X,Y,NOLCK Q
EN1 ;PRINT RANGE OF TRANSACTIONS
S PRCF("X")="ABFS" D ^PRCFSITE G:'% OUT
R1 S C="R1",D=1 W !,"START WITH TRANSACTION NUMBER: 1// " R X:$S($D(DTIME):DTIME,1:300) S:X="" X=1 G:X["^" OUT G:X["?"!(X'?1.5N)!(+X'=X)!(X<1)!(X>PRCB("LAST")) Q1 S FR=X K X
R2 S C="R2",D=FR R !!,"GO TO TRANSACTION NUMBER: LAST// ",X:$S($D(DTIME):DTIME,1:300) S:X="" X=PRCB("LAST") G:X["^" OUT G:X["?"!(X'?1.4N)!(+X'=X)!(X<FR)!(X>PRCB("LAST")) Q1 S TO=X
S X="0000"_FR,X=$E(X,$L(X)-4,$L(X)),FR=PRCF("SIFY")_"-"_X S X="0000"_TO,X=$E(X,$L(X)-4,$L(X)),TO=PRCF("SIFY")_"-"_X
D ZIS G:POP OUT S FLDS=$S(IOM<81:"[PRCB TRANS RANGE DISPLAY]",1:"[PRCB TRANS RANGE LIST]")
S DIC="^PRCF(421,",BY="[PRCB BY TRANSACTION NUMBER]",L=0 D EN1^DIP D H G OUT
Q1 W !!,$C(7),"ENTER A NUMBER BETWEEN ",D," AND ",PRCB("LAST"),". ('^' TO EXIT)" G @(C)
;
EN2 ;PRINT SELECTED CONTROL POINTS
;Patch 3: This section no longer calls the PRCFQ. It calls %ZTLOAD.
S NOTSK=0,NOLCK=0,EN2Q=0,EN2P=0,RECFLG=0
K DIC("A") S PRCF("X")="ABFS" D ^PRCFSITE G:'% OUT
S ^XTMP("PRCBP",$J)=""
S DIC("A")="Select FUND CONTROL POINT: "
F ZX=1:1 D Q:$G(Y)<0!($G(Y)="") Q:$G(OUT)=1
.S DIC(0)="AEQZMN",DIC="^PRC(420,PRC(""SITE""),1,"
.D ^DIC K DIC("A")
.Q:Y<0
.S CP=+Y
.D EN23
.I X=U K ^XTMP("PRCBP",$J) S OUT=1 Q
.I RECFLG=0 D
..D EOP^PRC0A(.X,.Y,"No TXN for selected STATION, FISCAL, and Fund Control Point.","AO","")
.S DIC("A")="ANOTHER FUND CONTROL POINT: "
K ZX
I $G(OUT)=1 K OUT G OUT
I X=U K ^XTMP("PRCBP",$J) G CLNUP
I '$O(^XTMP("PRCBP",$J,"AM",0)) G CLNUP
K IO("Q"),IOP,ZTSK,%ZIS,IOC,ZTIO
S %ZIS="NQ",%ZIS("B")="" D ^%ZIS I POP K ^XTMP("PRCBP",$J) G CLNUP
I '$D(IO("Q")) S CP=9999 D EN23 S EN2P=1,EN2Q=0 G EN2P
S EN2Q=1,EN2P=0
S ZTDESC="PRINT SELECTED CONTROL POINTS",ZTRTN="EN2Q^PRCBP"
S ZTSAVE("PRCF*")="",ZTSAVE("PRC*")=""
D ^%ZTLOAD D ^%ZISC
I '$D(ZTSK) S NOTSK=1 D ERRMSG G CLNUP
W !," <Request Queued> Your Task number is: ",ZTSK,$C(7),!
S TSKNUM=ZTSK,AQ=0,NOLCK=0
S ^XTMP("PRCBP",TSKNUM)=""
L +^XTMP("PRCBP",TSKNUM):5
E S NOLCK=1 D ERRMSG G CLNUP
F LOOP=1:1 S AQ=$O(^XTMP("PRCBP",$J,"AM",1,AQ)) Q:AQ="" D
.S ^XTMP("PRCBP",TSKNUM,"AQ",1,AQ)=""
S AQ=$O(^PRCF(421,"AC",PRCF("SIFY")_"-"_9999,AQ))
S ^XTMP("PRCBP",TSKNUM,"AQ",1,AQ)=""
K ^XTMP("PRCBP",$J)
L -^XTMP("PRCBP",TSKNUM)
G CLNUP
;
EN2Q ;Queue the Print Task(s).
;
D:$D(ZTQUEUED) KILL^%ZTLOAD
I '$D(ZTSK) S NOTSK=1 D ERRMSG G CLNUP
K TSKNUM S AQ=0,TSKNUM=ZTSK,NOTSK=0,NOLCK=0,EN2Q=1,EN2P=0
G EN2P
;
ERRMSG ;Write the error messages.
;
N DTIME S DTIME=60
I NOTSK=1 D
.W !,"Could not get a Task Number. Enter RETURN or '^' to exit. "
.R !,ANS:DTIME
;
CLNUP ;Clean variables that no longer needed.
;
D OUT
K TSKNUM,PRC,IOP,%ZIS,IOC,ZTIO,IO("Q"),ION,IOP,RECFLG,NOTSK
K AQ,LOOP,DIC,L,BY,FLDS,CP,ANS,I,N,EN2P,EN2Q,NOLCK,AM
K ZTDESC,ZTQUEUED,ZTRTN,ZTSAVE("PRC*"),ZTSAVE("PRCF*")
Q
;
EN2P ;Print the Task(s).
;
D:$D(ZTQUEUED) KILL^%ZTLOAD
S AM=0,AQ=0
S FLDS=$S(IOM<81:"[PRCB FCP DISPLAY]",1:"[PRCB FCP LIST]")
S DIC="^PRCF(421,",BY="[PRCB BY SEARCH/FCP/TRANS]"
S L=0,IOP=ION
I EN2P D
.F LOOP=1:1 S AM=$O(^XTMP("PRCBP",$J,"AM",1,AM)) Q:AM="" D
..S ^PRCF(421,"AM",1,AM)=""
.K ^XTMP("PRCBP",$J)
I EN2Q D
.F LOOP=1:1 S AQ=$O(^XTMP("PRCBP",TSKNUM,"AQ",1,AQ)) Q:AQ="" D
..S ^PRCF(421,"AM",1,AQ)=""
.K ^XTMP("PRCBP",TSKNUM)
D EN1^DIP
K ^PRCF(421,"AM")
G CLNUP
;
EN23 ;Setup the temp file with selected records (FCP).
;
S N=0,RECFLG=0
F I=1:1 S N=$O(^PRCF(421,"AC",PRCF("SIFY")_"-"_CP,N)) Q:N="" D
.S RECFLG=1
.S ^XTMP("PRCBP",$J,"AM",1,N)=""
.S $P(^PRCF(421,N,2),"^",14)=1
.W:CP'=9999 "."
Q
EN3 ;PRINT BY TDA NUMBER
S PRCF("X")="ABFS" D ^PRCFSITE G:'% OUT
S FR=$O(^PRCF(421,"B",PRCF("SIFY")_"-00000")) I FR="" W !,"NO TRANSACTIONS IN FY ",PRC("FY") R X:2 G OUT
Q31 D DD^PRC0A(.X,.Y,"Beginning TDA Number","421,3O",1)
G EN3:Y=""!(Y["^")
S PRCA=Y
Q32 D DD^PRC0A(.X,.Y,"Ending TDA Number","421,3O",9999)
G EN3:Y["^",Q31:Y=""
I PRCA]Y D EN^DDIOL("Beginning/Ending TDA numbers are not in order") G Q32
S PRCB=Y
S FR=PRCF("SIFY")_","_PRCA,TO=PRCF("SIFY")_","_PRCB
S ZTDESC="PRINT TDA LISTING",ZTRTN="EN1Q^PRCBP",ZTSAVE("PRC*")="",ZTSAVE("PRCF*")="",ZTSAVE("FR")="",ZTSAVE("TO")="" D ^PRCFQ,H,OUT Q
EN1Q S IOP=ION,FLDS=$S(IOM<81:"[PRCB TDA DISPLAY]",1:"[PRCB TDA LIST]")
;S DIC="^PRCF(421,",BY="[PRCB BY TRANS/TDA]",L=0 D EN1^DIP,H,OUT
S DIC="^PRCF(421,",BY="]@.5,3",L=0 D EN1^DIP,H,OUT
Q
EN4 ;FTEE SUMMARY BY PROGRAM
S PRCF("X")="ABFS" D ^PRCFSITE G:'% OUT S L=0,DIC="^PRCF(421,",BY="[PRCB BY APPROP/TDA]",FR=PRCF("SIFY"),TO=PRCF("SIFY")_"Z",FLDS="[PRCB FTEE SUMMARY]" D EN1^DIP,OUT Q
EN5 ;APPROPRIATION SUMMARY (DETAIL)
S PRCF("X")="ABFS" D ^PRCFSITE G:'% OUT
S ZTDESC="APPROPRIATION SUMMARY (DETAIL)",ZTRTN="EN5Q^PRCBP",ZTSAVE("PRC*")="",ZTSAVE("PRCF*")="" D ^PRCFQ,OUT Q
EN5Q S FLDS=$S(IOM<81:"[PRCB DISPLAY APP SUM DETAIL]",1:"[PRCB APPROP SUM DETAIL]")
S IOP=ION,L=0,DIC="^PRCF(421,",BY="[PRCB BY APP/FCP]",FR=PRCF("SIFY"),TO=PRCF("SIFY") D EN1^DIP,OUT Q
EN6 ;APPROPTIATION SUMMARY (TOTALS)
S PRCF("X")="ABFS" D ^PRCFSITE G:'% OUT
S ZTDESC="APPROPRIATION SUMMARY (TOTALS)",ZTRTN="EN6Q^PRCBP",ZTSAVE("PRC*")="",ZTSAVE("PRCF*")="" D ^PRCFQ,OUT Q
EN6Q S IOP=PRIOP,L=0,DIC="^PRCF(421,",BY="[PRCB BY APP/FCP]",FR=PRCF("SIFY"),TO=PRCF("SIFY"),FLDS="[PRCB APPROP SUM TOTAL]" D EN1^DIP,OUT Q
H I $D(IO(0)),IO=IO(0),$D(IOST),IOST["C-" W !,"PRESS RETURN TO CONTINUE",$C(7) R X:$S($D(DTIME):DTIME,1:300)
Q
ZIS K DQTIME,IOP S %ZIS="QN" D ^%ZIS Q:POP S IOP=ION I IO'=IO(0) S %ZIS="Q",IOP="Q;"_ION
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCBP 5953 printed Dec 13, 2024@02:00:45 Page 2
PRCBP ;WISC/CTB-PRINT OPTIONS FOR PRCB ;10/31/01 12:50pm
V ;;5.1;IFCAP;**3,43,139**;Oct 20, 2000;Build 16
+1 ;Per VHA Directive 2004-038, this routine should not be modified.
SE WRITE !!,$CHAR(7),"ENTRY TO THIS ROUTINE IS ONLY PERMITTED THROUGH THE APPROPRIATE",!,"MENU OR DRIVER"
QUIT
OUT KILL %,%Y,DIJ,DP,IOX,IOY,POP,PRCB,PRCF,PRC("CP"),X,Y,NOLCK
QUIT
EN1 ;PRINT RANGE OF TRANSACTIONS
+1 SET PRCF("X")="ABFS"
DO ^PRCFSITE
if '%
GOTO OUT
R1 SET C="R1"
SET D=1
WRITE !,"START WITH TRANSACTION NUMBER: 1// "
READ X:$SELECT($DATA(DTIME):DTIME,1:300)
if X=""
SET X=1
if X["^"
GOTO OUT
if X["?"!(X'?1.5N)!(+X'=X)!(X<1)!(X>PRCB("LAST"))
GOTO Q1
SET FR=X
KILL X
R2 SET C="R2"
SET D=FR
READ !!,"GO TO TRANSACTION NUMBER: LAST// ",X:$SELECT($DATA(DTIME):DTIME,1:300)
if X=""
SET X=PRCB("LAST")
if X["^"
GOTO OUT
if X["?"!(X'?1.4N)!(+X'=X)!(X<FR)!(X>PRCB("LAST"))
GOTO Q1
SET TO=X
+1 SET X="0000"_FR
SET X=$EXTRACT(X,$LENGTH(X)-4,$LENGTH(X))
SET FR=PRCF("SIFY")_"-"_X
SET X="0000"_TO
SET X=$EXTRACT(X,$LENGTH(X)-4,$LENGTH(X))
SET TO=PRCF("SIFY")_"-"_X
+2 DO ZIS
if POP
GOTO OUT
SET FLDS=$SELECT(IOM<81:"[PRCB TRANS RANGE DISPLAY]",1:"[PRCB TRANS RANGE LIST]")
+3 SET DIC="^PRCF(421,"
SET BY="[PRCB BY TRANSACTION NUMBER]"
SET L=0
DO EN1^DIP
DO H
GOTO OUT
Q1 WRITE !!,$CHAR(7),"ENTER A NUMBER BETWEEN ",D," AND ",PRCB("LAST"),". ('^' TO EXIT)"
GOTO @(C)
+1 ;
EN2 ;PRINT SELECTED CONTROL POINTS
+1 ;Patch 3: This section no longer calls the PRCFQ. It calls %ZTLOAD.
+2 SET NOTSK=0
SET NOLCK=0
SET EN2Q=0
SET EN2P=0
SET RECFLG=0
+3 KILL DIC("A")
SET PRCF("X")="ABFS"
DO ^PRCFSITE
if '%
GOTO OUT
+4 SET ^XTMP("PRCBP",$JOB)=""
+5 SET DIC("A")="Select FUND CONTROL POINT: "
+6 FOR ZX=1:1
Begin DoDot:1
+7 SET DIC(0)="AEQZMN"
SET DIC="^PRC(420,PRC(""SITE""),1,"
+8 DO ^DIC
KILL DIC("A")
+9 if Y<0
QUIT
+10 SET CP=+Y
+11 DO EN23
+12 IF X=U
KILL ^XTMP("PRCBP",$JOB)
SET OUT=1
QUIT
+13 IF RECFLG=0
Begin DoDot:2
+14 DO EOP^PRC0A(.X,.Y,"No TXN for selected STATION, FISCAL, and Fund Control Point.","AO","")
End DoDot:2
+15 SET DIC("A")="ANOTHER FUND CONTROL POINT: "
End DoDot:1
if $GET(Y)<0!($GET(Y)="")
QUIT
if $GET(OUT)=1
QUIT
+16 KILL ZX
+17 IF $GET(OUT)=1
KILL OUT
GOTO OUT
+18 IF X=U
KILL ^XTMP("PRCBP",$JOB)
GOTO CLNUP
+19 IF '$ORDER(^XTMP("PRCBP",$JOB,"AM",0))
GOTO CLNUP
+20 KILL IO("Q"),IOP,ZTSK,%ZIS,IOC,ZTIO
+21 SET %ZIS="NQ"
SET %ZIS("B")=""
DO ^%ZIS
IF POP
KILL ^XTMP("PRCBP",$JOB)
GOTO CLNUP
+22 IF '$DATA(IO("Q"))
SET CP=9999
DO EN23
SET EN2P=1
SET EN2Q=0
GOTO EN2P
+23 SET EN2Q=1
SET EN2P=0
+24 SET ZTDESC="PRINT SELECTED CONTROL POINTS"
SET ZTRTN="EN2Q^PRCBP"
+25 SET ZTSAVE("PRCF*")=""
SET ZTSAVE("PRC*")=""
+26 DO ^%ZTLOAD
DO ^%ZISC
+27 IF '$DATA(ZTSK)
SET NOTSK=1
DO ERRMSG
GOTO CLNUP
+28 WRITE !," <Request Queued> Your Task number is: ",ZTSK,$CHAR(7),!
+29 SET TSKNUM=ZTSK
SET AQ=0
SET NOLCK=0
+30 SET ^XTMP("PRCBP",TSKNUM)=""
+31 LOCK +^XTMP("PRCBP",TSKNUM):5
+32 IF '$TEST
SET NOLCK=1
DO ERRMSG
GOTO CLNUP
+33 FOR LOOP=1:1
SET AQ=$ORDER(^XTMP("PRCBP",$JOB,"AM",1,AQ))
if AQ=""
QUIT
Begin DoDot:1
+34 SET ^XTMP("PRCBP",TSKNUM,"AQ",1,AQ)=""
End DoDot:1
+35 SET AQ=$ORDER(^PRCF(421,"AC",PRCF("SIFY")_"-"_9999,AQ))
+36 SET ^XTMP("PRCBP",TSKNUM,"AQ",1,AQ)=""
+37 KILL ^XTMP("PRCBP",$JOB)
+38 LOCK -^XTMP("PRCBP",TSKNUM)
+39 GOTO CLNUP
+40 ;
EN2Q ;Queue the Print Task(s).
+1 ;
+2 if $DATA(ZTQUEUED)
DO KILL^%ZTLOAD
+3 IF '$DATA(ZTSK)
SET NOTSK=1
DO ERRMSG
GOTO CLNUP
+4 KILL TSKNUM
SET AQ=0
SET TSKNUM=ZTSK
SET NOTSK=0
SET NOLCK=0
SET EN2Q=1
SET EN2P=0
+5 GOTO EN2P
+6 ;
ERRMSG ;Write the error messages.
+1 ;
+2 NEW DTIME
SET DTIME=60
+3 IF NOTSK=1
Begin DoDot:1
+4 WRITE !,"Could not get a Task Number. Enter RETURN or '^' to exit. "
+5 READ !,ANS:DTIME
End DoDot:1
+6 ;
CLNUP ;Clean variables that no longer needed.
+1 ;
+2 DO OUT
+3 KILL TSKNUM,PRC,IOP,%ZIS,IOC,ZTIO,IO("Q"),ION,IOP,RECFLG,NOTSK
+4 KILL AQ,LOOP,DIC,L,BY,FLDS,CP,ANS,I,N,EN2P,EN2Q,NOLCK,AM
+5 KILL ZTDESC,ZTQUEUED,ZTRTN,ZTSAVE("PRC*"),ZTSAVE("PRCF*")
+6 QUIT
+7 ;
EN2P ;Print the Task(s).
+1 ;
+2 if $DATA(ZTQUEUED)
DO KILL^%ZTLOAD
+3 SET AM=0
SET AQ=0
+4 SET FLDS=$SELECT(IOM<81:"[PRCB FCP DISPLAY]",1:"[PRCB FCP LIST]")
+5 SET DIC="^PRCF(421,"
SET BY="[PRCB BY SEARCH/FCP/TRANS]"
+6 SET L=0
SET IOP=ION
+7 IF EN2P
Begin DoDot:1
+8 FOR LOOP=1:1
SET AM=$ORDER(^XTMP("PRCBP",$JOB,"AM",1,AM))
if AM=""
QUIT
Begin DoDot:2
+9 SET ^PRCF(421,"AM",1,AM)=""
End DoDot:2
+10 KILL ^XTMP("PRCBP",$JOB)
End DoDot:1
+11 IF EN2Q
Begin DoDot:1
+12 FOR LOOP=1:1
SET AQ=$ORDER(^XTMP("PRCBP",TSKNUM,"AQ",1,AQ))
if AQ=""
QUIT
Begin DoDot:2
+13 SET ^PRCF(421,"AM",1,AQ)=""
End DoDot:2
+14 KILL ^XTMP("PRCBP",TSKNUM)
End DoDot:1
+15 DO EN1^DIP
+16 KILL ^PRCF(421,"AM")
+17 GOTO CLNUP
+18 ;
EN23 ;Setup the temp file with selected records (FCP).
+1 ;
+2 SET N=0
SET RECFLG=0
+3 FOR I=1:1
SET N=$ORDER(^PRCF(421,"AC",PRCF("SIFY")_"-"_CP,N))
if N=""
QUIT
Begin DoDot:1
+4 SET RECFLG=1
+5 SET ^XTMP("PRCBP",$JOB,"AM",1,N)=""
+6 SET $PIECE(^PRCF(421,N,2),"^",14)=1
+7 if CP'=9999
WRITE "."
End DoDot:1
+8 QUIT
EN3 ;PRINT BY TDA NUMBER
+1 SET PRCF("X")="ABFS"
DO ^PRCFSITE
if '%
GOTO OUT
+2 SET FR=$ORDER(^PRCF(421,"B",PRCF("SIFY")_"-00000"))
IF FR=""
WRITE !,"NO TRANSACTIONS IN FY ",PRC("FY")
READ X:2
GOTO OUT
Q31 DO DD^PRC0A(.X,.Y,"Beginning TDA Number","421,3O",1)
+1 if Y=""!(Y["^")
GOTO EN3
+2 SET PRCA=Y
Q32 DO DD^PRC0A(.X,.Y,"Ending TDA Number","421,3O",9999)
+1 if Y["^"
GOTO EN3
if Y=""
GOTO Q31
+2 IF PRCA]Y
DO EN^DDIOL("Beginning/Ending TDA numbers are not in order")
GOTO Q32
+3 SET PRCB=Y
+4 SET FR=PRCF("SIFY")_","_PRCA
SET TO=PRCF("SIFY")_","_PRCB
+5 SET ZTDESC="PRINT TDA LISTING"
SET ZTRTN="EN1Q^PRCBP"
SET ZTSAVE("PRC*")=""
SET ZTSAVE("PRCF*")=""
SET ZTSAVE("FR")=""
SET ZTSAVE("TO")=""
DO ^PRCFQ
DO H
DO OUT
QUIT
EN1Q SET IOP=ION
SET FLDS=$SELECT(IOM<81:"[PRCB TDA DISPLAY]",1:"[PRCB TDA LIST]")
+1 ;S DIC="^PRCF(421,",BY="[PRCB BY TRANS/TDA]",L=0 D EN1^DIP,H,OUT
+2 SET DIC="^PRCF(421,"
SET BY="]@.5,3"
SET L=0
DO EN1^DIP
DO H
DO OUT
+3 QUIT
EN4 ;FTEE SUMMARY BY PROGRAM
+1 SET PRCF("X")="ABFS"
DO ^PRCFSITE
if '%
GOTO OUT
SET L=0
SET DIC="^PRCF(421,"
SET BY="[PRCB BY APPROP/TDA]"
SET FR=PRCF("SIFY")
SET TO=PRCF("SIFY")_"Z"
SET FLDS="[PRCB FTEE SUMMARY]"
DO EN1^DIP
DO OUT
QUIT
EN5 ;APPROPRIATION SUMMARY (DETAIL)
+1 SET PRCF("X")="ABFS"
DO ^PRCFSITE
if '%
GOTO OUT
+2 SET ZTDESC="APPROPRIATION SUMMARY (DETAIL)"
SET ZTRTN="EN5Q^PRCBP"
SET ZTSAVE("PRC*")=""
SET ZTSAVE("PRCF*")=""
DO ^PRCFQ
DO OUT
QUIT
EN5Q SET FLDS=$SELECT(IOM<81:"[PRCB DISPLAY APP SUM DETAIL]",1:"[PRCB APPROP SUM DETAIL]")
+1 SET IOP=ION
SET L=0
SET DIC="^PRCF(421,"
SET BY="[PRCB BY APP/FCP]"
SET FR=PRCF("SIFY")
SET TO=PRCF("SIFY")
DO EN1^DIP
DO OUT
QUIT
EN6 ;APPROPTIATION SUMMARY (TOTALS)
+1 SET PRCF("X")="ABFS"
DO ^PRCFSITE
if '%
GOTO OUT
+2 SET ZTDESC="APPROPRIATION SUMMARY (TOTALS)"
SET ZTRTN="EN6Q^PRCBP"
SET ZTSAVE("PRC*")=""
SET ZTSAVE("PRCF*")=""
DO ^PRCFQ
DO OUT
QUIT
EN6Q SET IOP=PRIOP
SET L=0
SET DIC="^PRCF(421,"
SET BY="[PRCB BY APP/FCP]"
SET FR=PRCF("SIFY")
SET TO=PRCF("SIFY")
SET FLDS="[PRCB APPROP SUM TOTAL]"
DO EN1^DIP
DO OUT
QUIT
H IF $DATA(IO(0))
IF IO=IO(0)
IF $DATA(IOST)
IF IOST["C-"
WRITE !,"PRESS RETURN TO CONTINUE",$CHAR(7)
READ X:$SELECT($DATA(DTIME):DTIME,1:300)
+1 QUIT
ZIS KILL DQTIME,IOP
SET %ZIS="QN"
DO ^%ZIS
if POP
QUIT
SET IOP=ION
IF IO'=IO(0)
SET %ZIS="Q"
SET IOP="Q;"_ION
