| [613] | 1 | ORGUEM3 ; slc/KCM - Setup Formatted Protocol Menus (cont) ;7/13/92 15:40
|
|---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
|
|---|
| 3 | ;;
|
|---|
| 4 | HLP ;Provide help for ORCL PROTOCOL MENU SETUP menu
|
|---|
| 5 | N ORGPOP
|
|---|
| 6 | I X="?" D G HLPX
|
|---|
| 7 | . D DISP^XQORM1
|
|---|
| 8 | . W !!
|
|---|
| 9 | I X["??" D G HLPX
|
|---|
| 10 | . N Y D SEQ(+XQORNOD,.Y)
|
|---|
| 11 | . S (DX,DY)=0 X ^%ZOSF("XY")
|
|---|
| 12 | . F I=1:1:Y I ^ORD(101,$P(Y(I),"^",2),0)'?1"ORB".E D Q:$D(ORGPOP)
|
|---|
| 13 | . . W !,$P(^ORD(101,+XQORNOD,10,+Y(I),0),"^",2)
|
|---|
| 14 | . . S J=0 F S J=$O(^ORD(101,$P(Y(I),"^",2),1,J)) Q:J'>0 D Q:$D(ORGPOP)
|
|---|
| 15 | . . . W ?5,^ORD(101,$P(Y(I),"^",2),1,J,0),!
|
|---|
| 16 | . . . I $Y>22 D
|
|---|
| 17 | . . . . W "Press RETURN to continue or '^' to exit: "
|
|---|
| 18 | . . . . R X:DTIME S:'$T!(X["^") ORGPOP=1 W $C(13)
|
|---|
| 19 | . . . . S (DX,DY)=0 X ^%ZOSF("XY")
|
|---|
| 20 | . W !
|
|---|
| 21 | HLPX Q
|
|---|
| 22 | SEQ(PCL,Y) ; For the named protocol (PCL) return array of items in sequence
|
|---|
| 23 | ; Y must be call by reference, returned is Y(n)=item ien^protocol
|
|---|
| 24 | N X,SEQ,ITM K Y ;(make sure Y is empty)
|
|---|
| 25 | S Y=0 ; Y is returned 0 if no items found
|
|---|
| 26 | S ITM=0 F S ITM=$O(^ORD(101,PCL,10,ITM)) Q:ITM'>0 D
|
|---|
| 27 | . S X=^ORD(101,PCL,10,ITM,0)
|
|---|
| 28 | . ;precedence for sequence is SEQUENCE, numeric MNEMONIC, alpha MNEMONIC, alpha ITEM TEXT
|
|---|
| 29 | . S SEQ=$S(+$P(X,"^",3):+$P(X,"^",3),+$P(X,"^",2):+$P(X,"^",2),$L($P(X,"^",2)):"M"_$P(X,"^",2),1:"Z"_$P(^ORD(101,+X,0),"^",2))
|
|---|
| 30 | . S X(SEQ,ITM)=+X
|
|---|
| 31 | S SEQ="" F S SEQ=$O(X(SEQ)) Q:SEQ="" D
|
|---|
| 32 | . S ITM="" F S ITM=$O(X(SEQ,ITM)) Q:ITM="" D
|
|---|
| 33 | . . S Y=Y+1,Y(Y)=ITM_"^"_X(SEQ,ITM)
|
|---|
| 34 | Q
|
|---|
| 35 | LIST ; List protocols on menu
|
|---|
| 36 | S %ZIS="Q" D ^%ZIS I POP D HOME^%ZIS Q
|
|---|
| 37 | I $D(IO("Q")) D Q
|
|---|
| 38 | . K IO("Q")
|
|---|
| 39 | . S ZTRTN="DQ^ORGUEM3",ZTDESC="List Menu Items",ZTSAVE("ORGMENU")=""
|
|---|
| 40 | . D ^%ZTLOAD W:$D(ZTSK) !,"List queued." K ZTSK
|
|---|
| 41 | . D HOME^%ZIS
|
|---|
| 42 | DQ U IO N CTM,EOP,ITM,LIST
|
|---|
| 43 | D SEQ(+ORGMENU,.LIST)
|
|---|
| 44 | S %DT="T",X="NOW" D ^%DT,DD^%DT S CTM=Y
|
|---|
| 45 | I $E(IOST)="C" W @IOF,$C(13)
|
|---|
| 46 | D HDR1
|
|---|
| 47 | F ITM=1:1:LIST S EOP=$$EOP(2) Q:EOP=-1 D:EOP=1 HDR D PITM(LIST(ITM))
|
|---|
| 48 | I $E(IOST)'="C" W @IOF
|
|---|
| 49 | I $D(ZTQUEUED) S ZTREQ="@"
|
|---|
| 50 | I '$D(ZTQUEUED) D ^%ZISC
|
|---|
| 51 | Q
|
|---|
| 52 | HDR ; Print header
|
|---|
| 53 | W @IOF,$C(13)
|
|---|
| 54 | HDR1 W "Menu: ",$P(ORGMENU,"^",2),?61,CTM,!!
|
|---|
| 55 | Q
|
|---|
| 56 | PITM(X) ; Print item fields
|
|---|
| 57 | ; ITEM: 123 Displayed Text ?64 SEQUENCE: 99.00
|
|---|
| 58 | ; NAME: NAME OF PROTOCOL (ITEM TEXT)
|
|---|
| 59 | W "ITEM: "
|
|---|
| 60 | I $P(^ORD(101,$P(X,"^",2),0),"^",2)?." " W "<blank line>"
|
|---|
| 61 | E D
|
|---|
| 62 | . W $P(^ORD(101,+ORGMENU,10,+X,0),"^",2)
|
|---|
| 63 | . W ?(6+$S($P($G(^ORD(101,+ORGMENU,4)),"^",2):$P(^(4),"^",2),1:5))
|
|---|
| 64 | . W $S($L($P(^ORD(101,+ORGMENU,10,+X,0),"^",6)):$P(^(0),"^",6),1:$P(^ORD(101,$P(X,"^",2),0),"^",2))
|
|---|
| 65 | W ?64,"SEQUENCE: ",$S($L($P(^ORD(101,+ORGMENU,10,+X,0),"^",3)):$J($P(^(0),"^",3),5,2),1:""),!
|
|---|
| 66 | W "PROTOCOL: ",$P(^ORD(101,$P(X,"^",2),0),"^")," "
|
|---|
| 67 | I $P(^ORD(101,$P(X,"^",2),0),"^",2)'?1." ",$L($P(^(0),"^",2)) W "(",$P(^(0),"^",2),")"
|
|---|
| 68 | W !!
|
|---|
| 69 | Q
|
|---|
| 70 | EOP(LINES) ; Check if end of page, handle CRT & printer advance
|
|---|
| 71 | I $Y<(IOSL-LINES) Q 0
|
|---|
| 72 | I $E(IOST)="C" D Q:X["^" -1
|
|---|
| 73 | . W "Press RETURN to continue or '^' to exit: "
|
|---|
| 74 | . R X:DTIME
|
|---|
| 75 | Q 1
|
|---|
