RARTVER ;HISC/FPT,CAH AISC/MJK,RMO-On-line Verify Reports ;09/24/08 10:27
;;5.0;Radiology/Nuclear Medicine;**8,23,26,82,56,95**;Mar 16, 1998;Build 7
;Supported IA #10035 ^DPT(
;Supported IA #10060 ^VA(200
D SET^RAPSET1 I $D(XQUIT) K XQUIT Q
N RAVFIED,RAXIT S RAXIT=0
K RAVER S:$D(^VA(200,DUZ,0)) RAVER=$P(^(0),"^") I '$D(RAVER) W !!,$C(7),"Your name must be defined in the NEW PERSON File to continue." G Q
I '$D(^VA(200,"ARC","R",DUZ)),'$D(^VA(200,"ARC","S",DUZ)) W !!,$C(7),"This option is only available for Rad/Nuc Med Interpreting Physicians." G Q
I '$$CHKUSR^RAO7UTL(DUZ) D ERR^RARTVER2(DUZ) D Q QUIT
I $D(^VA(200,"ARC","S",DUZ)) S RASTAFF=1 G 1
I $P(RAMDV,"^",18)'=1 W !!,$C(7),"Interpreting Residents are not allowed to verify reports.",!! G Q
1 S RAONLINE="" W ! D ES^RASIGU G Q:'%
I $D(RASTAFF),$P($G(^VA(200,DUZ,"RA")),U,2)'="y" S RARAD=DUZ,RAD="ASTF",RARESFLG="" G SRTRPT ;selected USER does NOT have ALLOW VERIFYING OF OTHERS
I '$D(^VA(200,"ARC","S",DUZ)),$S('$P(RAMDV,"^",18):1,'$D(^VA(200,"ARC","R",DUZ)):1,'$D(^VA(200,DUZ,"RA")):1,$P(^VA(200,DUZ,"RA"),"^",2)'="y":1,1:0) S RARAD=DUZ,RAD="ARES",RARESFLG="" G SRTRPT
ASKRAD W ! S DIC("B")=RAVER,DIC("S")="I $D(^VA(200,""ARC"",""R"",Y))!($D(^VA(200,""ARC"",""S"",Y)))",DIC("A")="Select Interpreting Physician: ",DIC="^VA(200,",DIC(0)="AEMQ" D ^DIC K DIC G Q:Y<0 S RARAD=+Y
S RAD=$S($D(^VA(200,"ARC","R",RARAD)):"ARES",1:"ASTF")
;
SRTRPT K ^TMP($J,"RA"),RA,RARPTX
S RARADHLD=RARAD,RATOT=0,RARPT=0
;tmp($j,"ra","dt",-,-) =
;^rpt status at start of selection^/long CN^Pat.ien^Proc.ien
F S RARPT=$O(^RARPT(RAD,RARAD,RARPT)) Q:'RARPT I $D(^RARPT(RARPT,0)) S RARTDT=$S($P(^(0),"^",6)="":9999999.9999,1:$P(^(0),"^",6)) D
.Q:$$STUB^RAEDCN1(RARPT) ;skip stub report 081500
.Q:"^V^EF^X^"[("^"_$P($G(^RARPT(+RARPT,0)),"^",5)_"^") ;skip V,EF,X
.S Y=RARPT D RASET^RAUTL2 ;returns Y=radpt(radfn,"dt",radti,"p",-,0)
.Q:'Y ;record must be corrupt no zero node for ADC x-ref!!
.S ^TMP($J,"RA","DT",RARTDT,RARPT)="^"_$P($G(^RARPT(+RARPT,0)),"^",5)_"^/"_$P(^(0),"^",1,2)_"^"_+$P(Y,U,2)
.S RATOT=RATOT+1
.Q
I 'RATOT S RANM=$S($D(^VA(200,RARAD,0)):$P(^(0),"^"),1:"UNKNOWN"),RANM=$S(RANM=RAVER:"You have",1:"Interpreting Physician "_RANM_" has") W !!,RANM," no Unverified Reports." G Q:$D(RARESFLG),ASKRAD
N RATOTORI S RATOTORI=RATOT ; save original value of RATOT
;
SELRPT I RATOT=1 D ONERPT^RARTVER1 G:'$D(^TMP($J,"RA")) Q S RACHOICE=5,RACHOICE("1RPT")="" G RPTLP
D TALLY^RARTVER1,SELRPT^RARTVER1 G Q:Y=0 S RACHOICE=+Y
I Y=1 D PV^RARTVER1 G:RATOT'>0 SRTRPT G RPTLP
I Y=2 S RASTATUS="R" D DPDRNV^RARTVER1 G:RATOT'>0 SRTRPT G RPTLP
I Y=3 S RASTATUS="D" D DPDRNV^RARTVER1 G:RATOT'>0 SRTRPT G RPTLP
I Y=4 S RASTATUS="PD" D DPDRNV^RARTVER1 G:RATOT'>0 SRTRPT G RPTLP
I Y=5 G RPTLP
I Y=7 D STAT^RARTVER1 G:RATOT'>0 SRTRPT G RPTLP
; if none of the above, then defaults to Y=6 SELECTED
S RASTATFG="" D ^RARTVER1 K RASTATFG G Q:$D(RAOUT)!('$D(RARPTX))
;
RPTLP S DIR(0)="S^P:PAGE AT A TIME;E:ENTIRE REPORT",DIR("B")="P",DIR("A")="How would you like to view the reports?"
S DIR("?",1)="If you would like to pause after each page of the report enter 'P'.",DIR("?")="Otherwise enter 'E' to view an entire report at one time."
D ^DIR K DIR G Q:$D(DIRUT) I Y="E" S RARTVERF=1
S RACHOICE("NAME")=$S(RACHOICE=6:"SELECTED",RACHOICE=5:"ALL",RACHOICE=4:"PROBLEM DRAFT",RACHOICE=3:"DRAFT",RACHOICE=2:"RELEASED/NOT VERIFIED",1:"PREVERIFIED")
RPTLP1 I $D(^TMP($J,"RA","DT")) S RARPT=0,RARTDT=0 F S RARTDT=$O(^TMP($J,"RA","DT",RARTDT)) Q:'RARTDT S RARDX="" D GETRPT Q:RARDX="^" I $D(RARLTV),$G(RARLTV)=0 D ADDLRPT^RARTVER2 Q:RATOT=0 S RARLTV=RATOT G RPTLP1
I $D(^TMP($J,"RA","XREF")) S (RPTX,RARPT)=0 D GETRPT
; RARESFLG is used to flag that VERIFYING OF OTHERS is allowed
; Before looping back, RARESFLG is set, so that if there are no reports,
; the logic will goto Q instead of to ASKRAD
I RATOTORI>1 S RARAD=RARADHLD,RARESFLG="" K RARLTV,RARTVERF G SRTRPT ; go another round
; also dis-allow re-asking another USER when all reports
; become verified by current USER
;
Q D CU^RARTVER2
Q
;
GETRPT I $G(RARPT) L -^RARPT(RARPT)
S:$D(^TMP($J,"RA","XREF")) RPTX=RPTX+1 S RARPT=$S($D(^TMP($J,"RA","DT")):$O(^TMP($J,"RA","DT",RARTDT,RARPT)),$D(^TMP($J,"RA","XREF")):+$G(RARPTX(RPTX)),1:0) Q:'RARPT
I $D(^TMP($J,"RA","DT")) G:$P(^TMP($J,"RA","DT",RARTDT,RARPT),"^")="V" GETRPT S $P(^TMP($J,"RA","DT",RARTDT,RARPT),"^")="V" ;here, V = viewed already
I '$D(^RARPT(RARPT)) D MSG1 G GETRPT ;rpt disappeared
L +^RARPT(RARPT):2 I '$T G LOCK^RARTVER2
S RAXIT=0 D DISRPT^RARTVER2 I $G(X)="^" S RARDX="^" Q ;display whole report
I +$G(RAVFIED) S RAVFIED=0 G GETRPT
N RASTBEF S RASTBEF=$S($D(^TMP($J,"RA","DT",+$G(RARTDT),+$G(RARPT))):$P(^(RARPT),"^",2),$D(^TMP($J,"RA","XREF")):$P($G(RARPTX(RPTX)),U,2),1:"")
ASK Q:RAXIT W ! S I="",$P(I,"=",80)="" W I K I
I "12345"[$E(RACHOICE) D:'$D(RARLTVFL) RLTV^RARTVER1 D:$D(RARLTVFL) RLTV1^RARTVER1
S RARD("A")="",RARD(1)="Print^print this report for editing",RARD(2)="Edit^edit this report",RARD(3)="Top^display the report from the beginning",RARD(4)="continue^continue normal processing"
S RARD(5)="Status & Print^edit Status, then print report",RARD(0)="S",RARD("B")=4
S:$G(RARLTV) RARLTV=RARLTV-1
I $G(RARLTV)>0 S RARD("A")="("_$G(RARLTV)_" left to review) "
I $G(RARLTV)=0 I '$D(RACHOICE("1RPT")) S RARD("A")="(No more "_RACHOICE("NAME")_") " S:RACHOICE=5 RARD("A")="(ALL gone) "
S RARD("A")=RARD("A")_"Type '?' for action list, 'Enter' to " ;12/30/96
I RASTBEF'=$P(^RARPT(RARPT,0),U,5) D MSG2
D SET^RARD K RARD S RARDX=$E(X) I RARDX="^" L -^RARPT(RARPT) Q
; if user chose "T"op, the report will be displayed again from the top
I "PT"[RARDX D PRTRPT^RARTVER2:RARDX="P",DISRPT^RARTVER2:RARDX="T" G ASK
I RARDX="E" D EDTCHK^RARTVER2 I RARDX="E" W !!,"EDITING REPORT",!,"--------------",! D EDTRPT^RARTE1 D K RAAB G ASK
.; RAHLTCPB flag is inactive
.N RAHLTCPB S RAHLTCPB=1 D:RACT="V" UPSTAT^RAUTL0 D:RACT'="V" UP1^RAUTL1
S RAPGM="GETRPT^RARTVER" G 31^RART ;goto Verify Report Only template
;
MSG1 N I,J1,J2,J3 S I=$S($D(^TMP($J,"RA","DT",+$G(RARTDT),+$G(RARPT))):^(RARPT),$D(^TMP($J,"RA","XREF")):$G(RARPTX(RPTX)),1:"")
S J1=$P(I,"/",2),J2=$P(J1,"^",2),J3=$P(J1,"^",3),J1=$P(J1,"^")
W !!!?15,$C(7),"Since the time you selected this group of reports,",!?15,"another user has deleted this report for",!?15,$P($G(^DPT(J2,0)),"^")," case ",J1,!?15,"Procedure ",$P($G(^RAMIS(71,+J3,0)),U),".",!! G CONT Q
MSG2 N I,J S I=";"_$P(^RARPT(RARPT,0),"^",5)_":"
S J=";"_$P(^DD(74,5,0),U,3)
W !!!?15,$C(7),"Since the time you selected this group of reports,",!?15,"another user has changed this report's status to '",$P($P(J,I,2),";"),"'.",!! Q
CONT W !! S DIR(0)="FO",DIR("A")="Press return key to continue " D ^DIR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRARTVER 6842 printed Oct 16, 2024@18:40:17 Page 2
RARTVER ;HISC/FPT,CAH AISC/MJK,RMO-On-line Verify Reports ;09/24/08 10:27
+1 ;;5.0;Radiology/Nuclear Medicine;**8,23,26,82,56,95**;Mar 16, 1998;Build 7
+2 ;Supported IA #10035 ^DPT(
+3 ;Supported IA #10060 ^VA(200
+4 DO SET^RAPSET1
IF $DATA(XQUIT)
KILL XQUIT
QUIT
+5 NEW RAVFIED,RAXIT
SET RAXIT=0
+6 KILL RAVER
if $DATA(^VA(200,DUZ,0))
SET RAVER=$PIECE(^(0),"^")
IF '$DATA(RAVER)
WRITE !!,$CHAR(7),"Your name must be defined in the NEW PERSON File to continue."
GOTO Q
+7 IF '$DATA(^VA(200,"ARC","R",DUZ))
IF '$DATA(^VA(200,"ARC","S",DUZ))
WRITE !!,$CHAR(7),"This option is only available for Rad/Nuc Med Interpreting Physicians."
GOTO Q
+8 IF '$$CHKUSR^RAO7UTL(DUZ)
DO ERR^RARTVER2(DUZ)
DO Q
QUIT
+9 IF $DATA(^VA(200,"ARC","S",DUZ))
SET RASTAFF=1
GOTO 1
+10 IF $PIECE(RAMDV,"^",18)'=1
WRITE !!,$CHAR(7),"Interpreting Residents are not allowed to verify reports.",!!
GOTO Q
1 SET RAONLINE=""
WRITE !
DO ES^RASIGU
if '%
GOTO Q
+1 ;selected USER does NOT have ALLOW VERIFYING OF OTHERS
IF $DATA(RASTAFF)
IF $PIECE($GET(^VA(200,DUZ,"RA")),U,2)'="y"
SET RARAD=DUZ
SET RAD="ASTF"
SET RARESFLG=""
GOTO SRTRPT
+2 IF '$DATA(^VA(200,"ARC","S",DUZ))
IF $SELECT('$PIECE(RAMDV,"^",18):1,'$DATA(^VA(200,"ARC","R",DUZ)):1,'$DATA(^VA(200,DUZ,"RA")):1,$PIECE(^VA(200,DUZ,"RA"),"^",2)'="y":1,1:0)
SET RARAD=DUZ
SET RAD="ARES"
SET RARESFLG=""
GOTO SRTRPT
ASKRAD WRITE !
SET DIC("B")=RAVER
SET DIC("S")="I $D(^VA(200,""ARC"",""R"",Y))!($D(^VA(200,""ARC"",""S"",Y)))"
SET DIC("A")="Select Interpreting Physician: "
SET DIC="^VA(200,"
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
if Y<0
GOTO Q
SET RARAD=+Y
+1 SET RAD=$SELECT($DATA(^VA(200,"ARC","R",RARAD)):"ARES",1:"ASTF")
+2 ;
SRTRPT KILL ^TMP($JOB,"RA"),RA,RARPTX
+1 SET RARADHLD=RARAD
SET RATOT=0
SET RARPT=0
+2 ;tmp($j,"ra","dt",-,-) =
+3 ;^rpt status at start of selection^/long CN^Pat.ien^Proc.ien
+4 FOR
SET RARPT=$ORDER(^RARPT(RAD,RARAD,RARPT))
if 'RARPT
QUIT
IF $DATA(^RARPT(RARPT,0))
SET RARTDT=$SELECT($PIECE(^(0),"^",6)="":9999999.9999,1:$PIECE(^(0),"^",6))
Begin DoDot:1
+5 ;skip stub report 081500
if $$STUB^RAEDCN1(RARPT)
QUIT
+6 ;skip V,EF,X
if "^V^EF^X^"[("^"_$PIECE($GET(^RARPT(+RARPT,0)),"^",5)_"^")
QUIT
+7 ;returns Y=radpt(radfn,"dt",radti,"p",-,0)
SET Y=RARPT
DO RASET^RAUTL2
+8 ;record must be corrupt no zero node for ADC x-ref!!
if 'Y
QUIT
+9 SET ^TMP($JOB,"RA","DT",RARTDT,RARPT)="^"_$PIECE($GET(^RARPT(+RARPT,0)),"^",5)_"^/"_$PIECE(^(0),"^",1,2)_"^"_+$PIECE(Y,U,2)
+10 SET RATOT=RATOT+1
+11 QUIT
End DoDot:1
+12 IF 'RATOT
SET RANM=$SELECT($DATA(^VA(200,RARAD,0)):$PIECE(^(0),"^"),1:"UNKNOWN")
SET RANM=$SELECT(RANM=RAVER:"You have",1:"Interpreting Physician "_RANM_" has")
WRITE !!,RANM," no Unverified Reports."
if $DATA(RARESFLG)
GOTO Q
GOTO ASKRAD
+13 ; save original value of RATOT
NEW RATOTORI
SET RATOTORI=RATOT
+14 ;
SELRPT IF RATOT=1
DO ONERPT^RARTVER1
if '$DATA(^TMP($JOB,"RA"))
GOTO Q
SET RACHOICE=5
SET RACHOICE("1RPT")=""
GOTO RPTLP
+1 DO TALLY^RARTVER1
DO SELRPT^RARTVER1
if Y=0
GOTO Q
SET RACHOICE=+Y
+2 IF Y=1
DO PV^RARTVER1
if RATOT'>0
GOTO SRTRPT
GOTO RPTLP
+3 IF Y=2
SET RASTATUS="R"
DO DPDRNV^RARTVER1
if RATOT'>0
GOTO SRTRPT
GOTO RPTLP
+4 IF Y=3
SET RASTATUS="D"
DO DPDRNV^RARTVER1
if RATOT'>0
GOTO SRTRPT
GOTO RPTLP
+5 IF Y=4
SET RASTATUS="PD"
DO DPDRNV^RARTVER1
if RATOT'>0
GOTO SRTRPT
GOTO RPTLP
+6 IF Y=5
GOTO RPTLP
+7 IF Y=7
DO STAT^RARTVER1
if RATOT'>0
GOTO SRTRPT
GOTO RPTLP
+8 ; if none of the above, then defaults to Y=6 SELECTED
+9 SET RASTATFG=""
DO ^RARTVER1
KILL RASTATFG
if $DATA(RAOUT)!('$DATA(RARPTX))
GOTO Q
+10 ;
RPTLP SET DIR(0)="S^P:PAGE AT A TIME;E:ENTIRE REPORT"
SET DIR("B")="P"
SET DIR("A")="How would you like to view the reports?"
+1 SET DIR("?",1)="If you would like to pause after each page of the report enter 'P'."
SET DIR("?")="Otherwise enter 'E' to view an entire report at one time."
+2 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO Q
IF Y="E"
SET RARTVERF=1
+3 SET RACHOICE("NAME")=$SELECT(RACHOICE=6:"SELECTED",RACHOICE=5:"ALL",RACHOICE=4:"PROBLEM DRAFT",RACHOICE=3:"DRAFT",RACHOICE=2:"RELEASED/NOT VERIFIED",1:"PREVERIFIED")
RPTLP1 IF $DATA(^TMP($JOB,"RA","DT"))
SET RARPT=0
SET RARTDT=0
FOR
SET RARTDT=$ORDER(^TMP($JOB,"RA","DT",RARTDT))
if 'RARTDT
QUIT
SET RARDX=""
DO GETRPT
if RARDX="^"
QUIT
IF $DATA(RARLTV)
IF $GET(RARLTV)=0
DO ADDLRPT^RARTVER2
if RATOT=0
QUIT
SET RARLTV=RATOT
GOTO RPTLP1
+1 IF $DATA(^TMP($JOB,"RA","XREF"))
SET (RPTX,RARPT)=0
DO GETRPT
+2 ; RARESFLG is used to flag that VERIFYING OF OTHERS is allowed
+3 ; Before looping back, RARESFLG is set, so that if there are no reports,
+4 ; the logic will goto Q instead of to ASKRAD
+5 ; go another round
IF RATOTORI>1
SET RARAD=RARADHLD
SET RARESFLG=""
KILL RARLTV,RARTVERF
GOTO SRTRPT
+6 ; also dis-allow re-asking another USER when all reports
+7 ; become verified by current USER
+8 ;
Q DO CU^RARTVER2
+1 QUIT
+2 ;
GETRPT IF $GET(RARPT)
LOCK -^RARPT(RARPT)
+1 if $DATA(^TMP($JOB,"RA","XREF"))
SET RPTX=RPTX+1
SET RARPT=$SELECT($DATA(^TMP($JOB,"RA","DT")):$ORDER(^TMP($JOB,"RA","DT",RARTDT,RARPT)),$DATA(^TMP($JOB,"RA","XREF")):+$GET(RARPTX(RPTX)),1:0)
if 'RARPT
QUIT
+2 ;here, V = viewed already
IF $DATA(^TMP($JOB,"RA","DT"))
if $PIECE(^TMP($JOB,"RA","DT",RARTDT,RARPT),"^")="V"
GOTO GETRPT
SET $PIECE(^TMP($JOB,"RA","DT",RARTDT,RARPT),"^")="V"
+3 ;rpt disappeared
IF '$DATA(^RARPT(RARPT))
DO MSG1
GOTO GETRPT
+4 LOCK +^RARPT(RARPT):2
IF '$TEST
GOTO LOCK^RARTVER2
+5 ;display whole report
SET RAXIT=0
DO DISRPT^RARTVER2
IF $GET(X)="^"
SET RARDX="^"
QUIT
+6 IF +$GET(RAVFIED)
SET RAVFIED=0
GOTO GETRPT
+7 NEW RASTBEF
SET RASTBEF=$SELECT($DATA(^TMP($JOB,"RA","DT",+$GET(RARTDT),+$GET(RARPT))):$PIECE(^(RARPT),"^",2),$DATA(^TMP($JOB,"RA","XREF")):$PIECE($GET(RARPTX(RPTX)),U,2),1:"")
ASK if RAXIT
QUIT
WRITE !
SET I=""
SET $PIECE(I,"=",80)=""
WRITE I
KILL I
+1 IF "12345"[$EXTRACT(RACHOICE)
if '$DATA(RARLTVFL)
DO RLTV^RARTVER1
if $DATA(RARLTVFL)
DO RLTV1^RARTVER1
+2 SET RARD("A")=""
SET RARD(1)="Print^print this report for editing"
SET RARD(2)="Edit^edit this report"
SET RARD(3)="Top^display the report from the beginning"
SET RARD(4)="continue^continue normal processing"
+3 SET RARD(5)="Status & Print^edit Status, then print report"
SET RARD(0)="S"
SET RARD("B")=4
+4 if $GET(RARLTV)
SET RARLTV=RARLTV-1
+5 IF $GET(RARLTV)>0
SET RARD("A")="("_$GET(RARLTV)_" left to review) "
+6 IF $GET(RARLTV)=0
IF '$DATA(RACHOICE("1RPT"))
SET RARD("A")="(No more "_RACHOICE("NAME")_") "
if RACHOICE=5
SET RARD("A")="(ALL gone) "
+7 ;12/30/96
SET RARD("A")=RARD("A")_"Type '?' for action list, 'Enter' to "
+8 IF RASTBEF'=$PIECE(^RARPT(RARPT,0),U,5)
DO MSG2
+9 DO SET^RARD
KILL RARD
SET RARDX=$EXTRACT(X)
IF RARDX="^"
LOCK -^RARPT(RARPT)
QUIT
+10 ; if user chose "T"op, the report will be displayed again from the top
+11 IF "PT"[RARDX
if RARDX="P"
DO PRTRPT^RARTVER2
if RARDX="T"
DO DISRPT^RARTVER2
GOTO ASK
+12 IF RARDX="E"
DO EDTCHK^RARTVER2
IF RARDX="E"
WRITE !!,"EDITING REPORT",!,"--------------",!
DO EDTRPT^RARTE1
Begin DoDot:1
+13 ; RAHLTCPB flag is inactive
+14 NEW RAHLTCPB
SET RAHLTCPB=1
if RACT="V"
DO UPSTAT^RAUTL0
if RACT'="V"
DO UP1^RAUTL1
End DoDot:1
KILL RAAB
GOTO ASK
+15 ;goto Verify Report Only template
SET RAPGM="GETRPT^RARTVER"
GOTO 31^RART
+16 ;
MSG1 NEW I,J1,J2,J3
SET I=$SELECT($DATA(^TMP($JOB,"RA","DT",+$GET(RARTDT),+$GET(RARPT))):^(RARPT),$DATA(^TMP($JOB,"RA","XREF")):$GET(RARPTX(RPTX)),1:"")
+1 SET J1=$PIECE(I,"/",2)
SET J2=$PIECE(J1,"^",2)
SET J3=$PIECE(J1,"^",3)
SET J1=$PIECE(J1,"^")
+2 WRITE !!!?15,$CHAR(7),"Since the time you selected this group of reports,",!?15,"another user has deleted this report for",!?15,$PIECE($GET(^DPT(J2,0)),"^")," case ",J1,!?15,"Procedure ",$PIECE($GET(^RAMIS(71,+J3,0)),U),".",!!
GOTO CONT
QUIT
MSG2 NEW I,J
SET I=";"_$PIECE(^RARPT(RARPT,0),"^",5)_":"
+1 SET J=";"_$PIECE(^DD(74,5,0),U,3)
+2 WRITE !!!?15,$CHAR(7),"Since the time you selected this group of reports,",!?15,"another user has changed this report's status to '",$PIECE($PIECE(J,I,2),";"),"'.",!!
QUIT
CONT WRITE !!
SET DIR(0)="FO"
SET DIR("A")="Press return key to continue "
DO ^DIR
+1 QUIT