source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LROPT.m@ 767

Last change on this file since 767 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.9 KB
RevLine 
[613]1LROPT ;SLC/BA- HELP FRAME INFO ON LAB OPTIONS ;2/19/91 11:09 ;
2 ;;5.2;LAB SERVICE;;Sep 27, 1994
3 ;
4BEGIN 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
5END K %,DIC,I,LRCHOICE,LRCNT,LRCONT,LRDIS,LREND,LRHELP,LRHF,LRHN,LRHREF,LRHTYPE,LRLINE,LRMAR,LROPT,LROPTN,LROPTT,LRSTOP,POP,X,Y
6 Q
7OPTION 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)
8 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"
9 I '$L(LRHELP) S:%<0 LREND=1 Q:%=2!LREND S LRCHOICE=2 D QUE Q
10 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)
11 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."
12 S:'$L(X) X=1 I X[U S LREND=1 Q
13 S LRCHOICE=X I X>2 S LRHREF=X,LRHELP=$P(LRHF(LRHREF),U,2),LRHN=$P(LRHF(LRHREF),U)
14QUE S ZTRTN="DQ^LROPT",%ZIS="MQ" D IO^LRWU
15 Q
16DQ S:$D(ZTQUEUED) ZTREQ="@" U IO
17X S LRHN="Option Description",LRMAR=$S($E(IOST,1,2)'="C-":2,1:0) D HDR
18 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
19 I LRCHOICE=1 Q
20 I LRCHOICE=2 D OPT Q
21 S LRHN=$P(LRHF(LRCHOICE),U) D HELP
22 Q
23OPT 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
24 Q
25HELP 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
26 Q
27CHECK I $Y+4>IOSL,$E(IOST,1,2)'="C-" S LRCONT=1 D HDR S LRCONT=0 Q
28 I $Y+4>IOSL D WAIT Q:LRSTOP S LRCONT=1 D HDR S LRCONT=0
29 Q
30WAIT W !,"Press return to continue or ""^"" to escape " R X:DTIME S:X="" X=1 S LRSTOP=$S("^"[X:1,1:0)
31 Q
32HDR W @IOF W:$E(IOST,1,2)'="C-" !! W !?(IOM/2)-($L(LROPTT)/2),LROPTT,!?(IOM/2)-($L(LROPTN)/2),LROPTN,!
33 I LRCONT W !!,LRHN," (continued)",!!
34 Q
35ALL S ZTRTN="BIG^LROPT",%ZIS="MQ" D IO^LRWU
36 D END
37 Q
38BIG S:$D(ZTQUEUED) ZTREQ="@" U IO
39 S DTIME=999,LRCHOICE=1,LRSTOP=0,LRCONT=0,U="^"
40 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
41 Q
42A 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
43 Q
Note: See TracBrowser for help on using the repository browser.