source: WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCA2.m@ 1154

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

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1GMRCA2 ;SLC/KCM,DLT - Select prompt for processing actions ;9/8/98 03:37
2 ;;3.0;CONSULT/REQUEST TRACKING;**1,4**;DEC 27, 1997
3SELECT(GMRCO) ; Select the consult to process
4 ;This utility checks the GMRCO variable against the selection list
5 ; Input variable used:
6 ; BLK, LNCT, GMRCO
7 ; GMRC("NMBR")
8 ; Output variables returned:
9 ; GMRCQUT=1 if no consult was selected
10 ; GMRCQUT is not defined on return when selection made
11 ; GMRCO= consult selected from list
12 K GMRCQUT,GMRCSEL
13 N GMRCAGN
14 I '$L($G(GMRCO)) D Q:$D(GMRCQUT) G:$D(GMRCAGN) SELECT
15 .;use the highlighted number if defined
16 .I $D(GMRC("NMBR")) S GMRCSEL=GMRC("NMBR")
17 .I '$D(GMRCSEL),$D(LNCT),LNCT=1 S GMRCSEL=LNCT
18 .I $S('+$G(GMRCSEL):1,+GMRCSEL<1:1,+GMRCSEL>BLK:1,GMRCSEL="":1,1:0) K GMRCSEL D:+$G(GMRC("NMBR")) AGAIN^GMRCSLMV(GMRC("NMBR")) K GMRC("NMBR")
19 .I '+$G(GMRCSEL) D SEL I $S($D(DTOUT):1,$D(DIROUT):1,$D(GMRCQUT):1,'+GMRCSEL:1,1:0) K GMRCSEL S GMRCQUT=1 Q
20 .I $S(+GMRCSEL<1:1,GMRCSEL>BLK:1,1:0) W !,"Select a consult listed in the number range 1 to "_BLK S GMRCAGN=1 Q
21 .S GMRCO=$O(^TMP("GMRCR",$J,"CS","AD",GMRCSEL,GMRCSEL,0))
22 .I '+GMRCO D
23 .. S GMRCQUT=1
24 .. W !,$C(7),"Select a consult by entering its listed number between 1 and "_LNCT_"."
25 .. K GMRCO,GMRCSEL
26 . Q
27 Q
28 ;
29SEL ;Select order number(s) exit: GMRCSEL
30 I $D(GMRC("NMBR")) S GMRCSEL=GMRC("NMBR") Q
31 I '$D(^TMP("GMRCR",$J,"CS","AD")) W !,"No orders to select.",! S GMRCQUT=1,GMRCSEL="" Q
32 I '$O(^TMP("GMRCR",$J,"CS","AD")),BLK=1 S GMRCSEL=BLK Q
33 S GMRCSEL="" W !,"CHOOSE No. 1-",BLK,": " R X:DTIME S:X="^^" DIROUT=1 I '$T!(X["^") S (DTOUT,GMRCQUT)=1 Q
34 I X["?" D SELHELP G SEL
35 I X="" S GMRCQUT=1 Q
36 I X'?.3N W $C(7)," ?? Enter the number from the far left of the list." G SEL
37 I $S(X>BLK:1,X<1:1,1:0) D SELHELP G SEL
38 S GMRCSEL=X
39 Q
40SELHELP ;Help to select a valid entry
41 W !,"Select a request by typing the number from the left column and pressing <ENTER>.",!
42 Q
43UP ;Convert lower to upper case entry: X exit: X
44 F %=1:1:$L(X) I $E(X,%)?1L S X=$E(X,1,%-1)_$C($A(X,%)-32)_$E(X,%+1,99)
45 Q
Note: See TracBrowser for help on using the repository browser.