LROPT.m

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 ---LROPT   3033     printed  Feb 18, 2025@23:44:27                                                                                                                                                                                                       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