| 1 | LROPTLST ;SLC/FHS - LIST OPTIONS FOR VERIFICATION ;2/19/91 11:10 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;;Sep 27, 1994
|
|---|
| 3 | EN ;
|
|---|
| 4 | S OK=1
|
|---|
| 5 | S OPTN=$S($D(OPTN):OPTN,1:"LRMENU")
|
|---|
| 6 | K IO("Q") S:$D(ZTQUEUED) ZTREQ="@" S OPT=$O(^DIC(19,"B",OPTN,0)) Q:OPT<1 K ^TMP($J),MENU,^TMP("OPT") S $P(LINE,"-",IOM)="",CNT=0,U="^"
|
|---|
| 7 | F I=0:0 S I=$O(^DIC(19,OPT,10,"B",I)) Q:I="" S ^TMP($J,I)=""
|
|---|
| 8 | SUB ;
|
|---|
| 9 | F I=0:0 S I=$O(^TMP($J,I)) Q:I<1 D:'$D(^DIC(19,I,10)) SORTI I $D(^DIC(19,I,10,"B")) W !!,LINE,!,$P(^DIC(19,I,0),U),!! F II=0:0 S II=$O(^DIC(19,I,10,"B",II)) D:II="" MSUB Q:II="" D SORT I 'OK G END
|
|---|
| 10 | SUB1 ;
|
|---|
| 11 | K MENU F I=0:0 S I=$O(^TMP($J,I)) Q:I<1 S MENU($P(^DIC(19,I,0),U,2))=I
|
|---|
| 12 | S O="" F A=0:0 S O=$O(MENU(O)) Q:O="" S I=MENU(O),PG=0 D HEAD S MTX="" F A=0:0 S MTX=$O(^TMP($J,"OPT",I,MTX)) Q:MTX="" S OPT=^(MTX) D PRT1
|
|---|
| 13 | W !!,LINE,!!?20,"TOTAL OPTIONS = ",CNT,!! W:$E(IOST,1,2)'="C-" @IOF
|
|---|
| 14 | END K CNT,OPTN,PG,O,I,II,A,OPT,MENU,LINE,IX,IO("Q"),DIC,%ZIS,DIS,MTX,X,^TMP($J) D ^%ZISC W !!?20," ******** END OF LISTING ********",!
|
|---|
| 15 | Q
|
|---|
| 16 | MSUB ;
|
|---|
| 17 | S II="",II=$O(MENU(I,II)) Q:II="" D SORT K MENU(I,II) G MSUB
|
|---|
| 18 | Q
|
|---|
| 19 | SORTI S II=I
|
|---|
| 20 | SORT ;
|
|---|
| 21 | I '$D(^DIC(19,II,0)) W !,"ERROR OPTION "_II_" IS MISSING " S OK=0 Q
|
|---|
| 22 | I $P(^DIC(19,II,0),U,4)="M" S IX="" F A=0:0 S IX=$O(^DIC(19,II,10,"B",IX)) Q:IX="" S MENU(I,IX)=""
|
|---|
| 23 | PRT ;
|
|---|
| 24 | I $P(^DIC(19,II,0),U,4)="M" Q
|
|---|
| 25 | S X=^DIC(19,II,0),OPT=$P(X,U),MTX=$P(X,U,2) I $D(^DIC(19,II,25)),$L(^(25)) S OPT=OPT_" ( "_^(25)_" ) "
|
|---|
| 26 | S ^TMP($J,"OPT",I,MTX)=OPT F DIS=0:0 S DIS=$O(^DIC(19,II,1,DIS)) Q:DIS="" S ^TMP($J,"OPT",I,MTX,1,DIS,0)=^(DIS,0)
|
|---|
| 27 | Q
|
|---|
| 28 | PRT1 ;
|
|---|
| 29 | I $Y>60 D HEAD
|
|---|
| 30 | S CNT=CNT+1 W !,MTX,?45,OPT F DIS=0:0 S DIS=$O(^TMP($J,"OPT",I,MTX,1,DIS)) Q:DIS="" W !,?5,^(DIS,0) I $Y>60 D HEAD W !,MTX,?40,OPT,!!?30,"<<< CONTINUED >>>",!
|
|---|
| 31 | W !!?20,$E(LINE,1,40),!
|
|---|
| 32 | Q
|
|---|
| 33 | QUE ;
|
|---|
| 34 | K DIC S DIC=19,DIC(0)="AEQM",DIC("S")="I $P(^(0),U,4)=""M""&($E(^(0),1,2)[""LR"")!($E(^(0),1,2)[""LA"")" D ^DIC G END:Y<1
|
|---|
| 35 | I '$O(^DIC(19,+Y,10,"B",0)) W !!?10,"THERE ARE NO ITEMS ON THE MENU ",$C(7) G END
|
|---|
| 36 | S OPTN=$P(Y,U,2) K IO("Q"),%ZIS S %ZIS="QN",%ZIS("A")="PRINTER DEVICE: " D ^%ZIS Q:POP I IO=IO(0) G EN
|
|---|
| 37 | S ZTSAVE("OPTN")="",ZTRTN="LROPTLST",ZTDESC="LIST OF MENU OPTIONS ",ZTIO=ION D ^%ZTLOAD
|
|---|
| 38 | W !,"QUEUED TO DEVICE ",ION D ^%ZISC K IO("Q") Q
|
|---|
| 39 | HEAD ;
|
|---|
| 40 | S PG=PG+1 W @IOF,!!!?10,"*************** ",$P(^DIC(19,I,0),U,2)," ****************** PG ",PG,!! Q
|
|---|
