LROPT ;SLC/BA- HELP FRAME INFO ON LAB OPTIONS ;2/19/91 11:09 ;
;;5.2;LAB SERVICE;;Sep 27, 1994
;
BEGIN S (LRSTOP,LREND,LRCONT)=0,U="^",DTIME=$S($D(DTIME):DTIME,1:999) W ! F I=0:0 D OPTION Q:LREND K LRDIS,LRHELP,LRHF,LRHREF,LRHTYPE,LRLINE,LROPTN S LRSTOP=0
END K %,DIC,I,LRCHOICE,LRCNT,LRCONT,LRDIS,LREND,LRHELP,LRHF,LRHN,LRHREF,LRHTYPE,LRLINE,LRMAR,LROPT,LROPTN,LROPTT,LRSTOP,POP,X,Y
Q
OPTION S DIC=19,DIC(0)="AEMQ",DIC("A")="Select Lab Option: ",DIC("S")="I $E(^(0),1,2)=""LR""" D ^DIC S:Y<1 LREND=1 Q:LREND S LROPT=+Y,LRHELP=$P(^DIC(19,LROPT,0),U,7),LROPTN=$P(^(0),U),LROPTT=$P(^(0),U,2)
I '$L(LRHELP) F I=0:0 W !,"No help frames are available on this option.",!,"Do you wish to display the option description" S %=1 D YN^DICN Q:% W !,"Answer 'Y'es or 'N'o"
I '$L(LRHELP) S:%<0 LREND=1 Q:%=2!LREND S LRCHOICE=2 D QUE Q
W !!!,?5,"1 All documentation",!?5,"2 Option description" S LRHREF=0,LRCNT=2 F I=0:0 S LRHREF=$O(^DIC(9.2,LRHELP,2,LRHREF)) Q:LRHREF<1 S LRHTYPE=^(LRHREF,0),LRCNT=LRCNT+1,LRHF(LRCNT)=LRHTYPE W !,?5,LRCNT," ",$P(^(0),U)
F I=0:0 R !,"Choose: 1// ",X:DTIME Q:X=""!(X[U)!(X>0&(X-1<LRCNT)&(X?1N.N)) W !,"Enter the number of the option you wish to display."
S:'$L(X) X=1 I X[U S LREND=1 Q
S LRCHOICE=X I X>2 S LRHREF=X,LRHELP=$P(LRHF(LRHREF),U,2),LRHN=$P(LRHF(LRHREF),U)
QUE S ZTRTN="DQ^LROPT",%ZIS="MQ" D IO^LRWU
Q
DQ S:$D(ZTQUEUED) ZTREQ="@" U IO
X S LRHN="Option Description",LRMAR=$S($E(IOST,1,2)'="C-":2,1:0) D HDR
I LRCHOICE=1 D OPT Q:LRSTOP S LRHREF=0 F I=0:0 S LRHREF=$O(LRHF(LRHREF)) Q:LRHREF="" S LRHELP=LRHF(LRHREF),LRHELP=$P(LRHELP,U,2),LRHN=$P(LRHF(LRHREF),U) I $L(LRHELP) D HELP Q:LRSTOP
I LRCHOICE=1 Q
I LRCHOICE=2 D OPT Q
S LRHN=$P(LRHF(LRCHOICE),U) D HELP
Q
OPT Q:'$O(^DIC(19,LROPT,1,0)) W !!?LRMAR,LRHN,!! S LRLINE=0 F I=0:0 S LRLINE=$O(^DIC(19,LROPT,1,LRLINE)) Q:LRLINE<1 S LRDIS=^(LRLINE,0) W ?(LRMAR+3),LRDIS,! D:$O(^DIC(19,LROPT,1,LRLINE)) CHECK Q:LRSTOP
Q
HELP Q:'$O(^DIC(9.2,LRHELP,1,0)) W !!?LRMAR,LRHN,!! S LRLINE=0 F I=0:0 S LRLINE=$O(^DIC(9.2,LRHELP,1,LRLINE)) Q:LRLINE<1 S LRDIS=^(LRLINE,0) W ?(LRMAR+3),LRDIS,! D:$O(^DIC(9.2,LRHELP,1,LRLINE)) CHECK Q:LRSTOP
Q
CHECK I $Y+4>IOSL,$E(IOST,1,2)'="C-" S LRCONT=1 D HDR S LRCONT=0 Q
I $Y+4>IOSL D WAIT Q:LRSTOP S LRCONT=1 D HDR S LRCONT=0
Q
WAIT W !,"Press return to continue or ""^"" to escape " R X:DTIME S:X="" X=1 S LRSTOP=$S("^"[X:1,1:0)
Q
HDR W @IOF W:$E(IOST,1,2)'="C-" !! W !?(IOM/2)-($L(LROPTT)/2),LROPTT,!?(IOM/2)-($L(LROPTN)/2),LROPTN,!
I LRCONT W !!,LRHN," (continued)",!!
Q
ALL S ZTRTN="BIG^LROPT",%ZIS="MQ" D IO^LRWU
D END
Q
BIG S:$D(ZTQUEUED) ZTREQ="@" U IO
S DTIME=999,LRCHOICE=1,LRSTOP=0,LRCONT=0,U="^"
S LROPTN="LRACC2" F I=0:0 S LROPTN=$O(^DIC(19,"B",LROPTN)) Q:LROPTN]"LRYZZZ" S LROPT=$O(^DIC(19,"B",LROPTN,0)),LROPTT=$P(^DIC(19,LROPT,0),U,2),LRHELP=$P(^(0),U,7) D A,X Q:LRSTOP H 15
Q
A Q:'$L(LRHELP) K LRDIS,LRHF,LRLINE S LRHREF=0 F I=0:0 S LRHREF=$O(^DIC(9.2,LRHELP,2,LRHREF)) Q:LRHREF<1 S LRHTYPE=^(LRHREF,0),LRHF(LRHREF)=LRHTYPE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLROPT 3033 printed Sep 23, 2025@19:54:14 Page 2
LROPT ;SLC/BA- HELP FRAME INFO ON LAB OPTIONS ;2/19/91 11:09 ;
+1 ;;5.2;LAB SERVICE;;Sep 27, 1994
+2 ;
BEGIN SET (LRSTOP,LREND,LRCONT)=0
SET U="^"
SET DTIME=$SELECT($DATA(DTIME):DTIME,1:999)
WRITE !
FOR I=0:0
DO OPTION
if LREND
QUIT
KILL LRDIS,LRHELP,LRHF,LRHREF,LRHTYPE,LRLINE,LROPTN
SET LRSTOP=0
END KILL %,DIC,I,LRCHOICE,LRCNT,LRCONT,LRDIS,LREND,LRHELP,LRHF,LRHN,LRHREF,LRHTYPE,LRLINE,LRMAR,LROPT,LROPTN,LROPTT,LRSTOP,POP,X,Y
+1 QUIT
OPTION SET DIC=19
SET DIC(0)="AEMQ"
SET DIC("A")="Select Lab Option: "
SET DIC("S")="I $E(^(0),1,2)=""LR"""
DO ^DIC
if Y<1
SET LREND=1
if LREND
QUIT
SET LROPT=+Y
SET LRHELP=$PIECE(^DIC(19,LROPT,0),U,7)
SET LROPTN=$PIECE(^(0),U)
SET LROPTT=$PIECE(^(0),U,2)
+1 IF '$LENGTH(LRHELP)
FOR I=0:0
WRITE !,"No help frames are available on this option.",!,"Do you wish to display the option description"
SET %=1
DO YN^DICN
if %
QUIT
WRITE !,"Answer 'Y'es or 'N'o"
+2 IF '$LENGTH(LRHELP)
if %<0
SET LREND=1
if %=2!LREND
QUIT
SET LRCHOICE=2
DO QUE
QUIT
+3 WRITE !!!,?5,"1 All documentation",!?5,"2 Option description"
SET LRHREF=0
SET LRCNT=2
FOR I=0:0
SET LRHREF=$ORDER(^DIC(9.2,LRHELP,2,LRHREF))
if LRHREF<1
QUIT
SET LRHTYPE=^(LRHREF,0)
SET LRCNT=LRCNT+1
SET LRHF(LRCNT)=LRHTYPE
WRITE !,?5,LRCNT," ",$PIECE(^(0),U)
+4 FOR I=0:0
READ !,"Choose: 1// ",X:DTIME
if X=""!(X[U)!(X>0&(X-1<LRCNT)&(X?1N.N))
QUIT
WRITE !,"Enter the number of the option you wish to display."
+5 if '$LENGTH(X)
SET X=1
IF X[U
SET LREND=1
QUIT
+6 SET LRCHOICE=X
IF X>2
SET LRHREF=X
SET LRHELP=$PIECE(LRHF(LRHREF),U,2)
SET LRHN=$PIECE(LRHF(LRHREF),U)
QUE SET ZTRTN="DQ^LROPT"
SET %ZIS="MQ"
DO IO^LRWU
+1 QUIT
DQ if $DATA(ZTQUEUED)
SET ZTREQ="@"
USE IO
X SET LRHN="Option Description"
SET LRMAR=$SELECT($EXTRACT(IOST,1,2)'="C-":2,1:0)
DO HDR
+1 IF LRCHOICE=1
DO OPT
if LRSTOP
QUIT
SET LRHREF=0
FOR I=0:0
SET LRHREF=$ORDER(LRHF(LRHREF))
if LRHREF=""
QUIT
SET LRHELP=LRHF(LRHREF)
SET LRHELP=$PIECE(LRHELP,U,2)
SET LRHN=$PIECE(LRHF(LRHREF),U)
IF $LENGTH(LRHELP)
DO HELP
if LRSTOP
QUIT
+2 IF LRCHOICE=1
QUIT
+3 IF LRCHOICE=2
DO OPT
QUIT
+4 SET LRHN=$PIECE(LRHF(LRCHOICE),U)
DO HELP
+5 QUIT
OPT if '$ORDER(^DIC(19,LROPT,1,0))
QUIT
WRITE !!?LRMAR,LRHN,!!
SET LRLINE=0
FOR I=0:0
SET LRLINE=$ORDER(^DIC(19,LROPT,1,LRLINE))
if LRLINE<1
QUIT
SET LRDIS=^(LRLINE,0)
WRITE ?(LRMAR+3),LRDIS,!
if $ORDER(^DIC(19,LROPT,1,LRLINE))
DO CHECK
if LRSTOP
QUIT
+1 QUIT
HELP if '$ORDER(^DIC(9.2,LRHELP,1,0))
QUIT
WRITE !!?LRMAR,LRHN,!!
SET LRLINE=0
FOR I=0:0
SET LRLINE=$ORDER(^DIC(9.2,LRHELP,1,LRLINE))
if LRLINE<1
QUIT
SET LRDIS=^(LRLINE,0)
WRITE ?(LRMAR+3),LRDIS,!
if $ORDER(^DIC(9.2,LRHELP,1,LRLINE))
DO CHECK
if LRSTOP
QUIT
+1 QUIT
CHECK IF $Y+4>IOSL
IF $EXTRACT(IOST,1,2)'="C-"
SET LRCONT=1
DO HDR
SET LRCONT=0
QUIT
+1 IF $Y+4>IOSL
DO WAIT
if LRSTOP
QUIT
SET LRCONT=1
DO HDR
SET LRCONT=0
+2 QUIT
WAIT WRITE !,"Press return to continue or ""^"" to escape "
READ X:DTIME
if X=""
SET X=1
SET LRSTOP=$SELECT("^"[X:1,1:0)
+1 QUIT
HDR WRITE @IOF
if $EXTRACT(IOST,1,2)'="C-"
WRITE !!
WRITE !?(IOM/2)-($LENGTH(LROPTT)/2),LROPTT,!?(IOM/2)-($LENGTH(LROPTN)/2),LROPTN,!
+1 IF LRCONT
WRITE !!,LRHN," (continued)",!!
+2 QUIT
ALL SET ZTRTN="BIG^LROPT"
SET %ZIS="MQ"
DO IO^LRWU
+1 DO END
+2 QUIT
BIG if $DATA(ZTQUEUED)
SET ZTREQ="@"
USE IO
+1 SET DTIME=999
SET LRCHOICE=1
SET LRSTOP=0
SET LRCONT=0
SET U="^"
+2 SET LROPTN="LRACC2"
FOR I=0:0
SET LROPTN=$ORDER(^DIC(19,"B",LROPTN))
if LROPTN]"LRYZZZ"
QUIT
SET LROPT=$ORDER(^DIC(19,"B",LROPTN,0))
SET LROPTT=$PIECE(^DIC(19,LROPT,0),U,2)
SET LRHELP=$PIECE(^(0),U,7)
DO A
DO X
if LRSTOP
QUIT
HANG 15
+3 QUIT
A if '$LENGTH(LRHELP)
QUIT
KILL LRDIS,LRHF,LRLINE
SET LRHREF=0
FOR I=0:0
SET LRHREF=$ORDER(^DIC(9.2,LRHELP,2,LRHREF))
if LRHREF<1
QUIT
SET LRHTYPE=^(LRHREF,0)
SET LRHF(LRHREF)=LRHTYPE
+1 QUIT
