source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORGUEM3.m@ 1211

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

initial load of WorldVistAEHR

File size: 2.8 KB
Line 
1ORGUEM3 ; slc/KCM - Setup Formatted Protocol Menus (cont) ;7/13/92 15:40
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
3 ;;
4HLP ;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 !
21HLPX Q
22SEQ(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
35LIST ; 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
42DQ 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
52HDR ; Print header
53 W @IOF,$C(13)
54HDR1 W "Menu: ",$P(ORGMENU,"^",2),?61,CTM,!!
55 Q
56PITM(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
70EOP(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
Note: See TracBrowser for help on using the repository browser.