GMRCA2 ;SLC/KCM,DLT - Select prompt for processing actions ;9/8/98 03:37
;;3.0;CONSULT/REQUEST TRACKING;**1,4**;DEC 27, 1997
SELECT(GMRCO) ; Select the consult to process
;This utility checks the GMRCO variable against the selection list
; Input variable used:
; BLK, LNCT, GMRCO
; GMRC("NMBR")
; Output variables returned:
; GMRCQUT=1 if no consult was selected
; GMRCQUT is not defined on return when selection made
; GMRCO= consult selected from list
K GMRCQUT,GMRCSEL
N GMRCAGN
I '$L($G(GMRCO)) D Q:$D(GMRCQUT) G:$D(GMRCAGN) SELECT
.;use the highlighted number if defined
.I $D(GMRC("NMBR")) S GMRCSEL=GMRC("NMBR")
.I '$D(GMRCSEL),$D(LNCT),LNCT=1 S GMRCSEL=LNCT
.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")
.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
.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
.S GMRCO=$O(^TMP("GMRCR",$J,"CS","AD",GMRCSEL,GMRCSEL,0))
.I '+GMRCO D
.. S GMRCQUT=1
.. W !,$C(7),"Select a consult by entering its listed number between 1 and "_LNCT_"."
.. K GMRCO,GMRCSEL
. Q
Q
;
SEL ;Select order number(s) exit: GMRCSEL
I $D(GMRC("NMBR")) S GMRCSEL=GMRC("NMBR") Q
I '$D(^TMP("GMRCR",$J,"CS","AD")) W !,"No orders to select.",! S GMRCQUT=1,GMRCSEL="" Q
I '$O(^TMP("GMRCR",$J,"CS","AD")),BLK=1 S GMRCSEL=BLK Q
S GMRCSEL="" W !,"CHOOSE No. 1-",BLK,": " R X:DTIME S:X="^^" DIROUT=1 I '$T!(X["^") S (DTOUT,GMRCQUT)=1 Q
I X["?" D SELHELP G SEL
I X="" S GMRCQUT=1 Q
I X'?.3N W $C(7)," ?? Enter the number from the far left of the list." G SEL
I $S(X>BLK:1,X<1:1,1:0) D SELHELP G SEL
S GMRCSEL=X
Q
SELHELP ;Help to select a valid entry
W !,"Select a request by typing the number from the left column and pressing <ENTER>.",!
Q
UP ;Convert lower to upper case entry: X exit: X
F %=1:1:$L(X) I $E(X,%)?1L S X=$E(X,1,%-1)_$C($A(X,%)-32)_$E(X,%+1,99)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCA2 2135 printed Dec 13, 2024@01:44:54 Page 2
GMRCA2 ;SLC/KCM,DLT - Select prompt for processing actions ;9/8/98 03:37
+1 ;;3.0;CONSULT/REQUEST TRACKING;**1,4**;DEC 27, 1997
SELECT(GMRCO) ; Select the consult to process
+1 ;This utility checks the GMRCO variable against the selection list
+2 ; Input variable used:
+3 ; BLK, LNCT, GMRCO
+4 ; GMRC("NMBR")
+5 ; Output variables returned:
+6 ; GMRCQUT=1 if no consult was selected
+7 ; GMRCQUT is not defined on return when selection made
+8 ; GMRCO= consult selected from list
+9 KILL GMRCQUT,GMRCSEL
+10 NEW GMRCAGN
+11 IF '$LENGTH($GET(GMRCO))
Begin DoDot:1
+12 ;use the highlighted number if defined
+13 IF $DATA(GMRC("NMBR"))
SET GMRCSEL=GMRC("NMBR")
+14 IF '$DATA(GMRCSEL)
IF $DATA(LNCT)
IF LNCT=1
SET GMRCSEL=LNCT
+15 IF $SELECT('+$GET(GMRCSEL):1,+GMRCSEL<1:1,+GMRCSEL>BLK:1,GMRCSEL="":1,1:0)
KILL GMRCSEL
if +$GET(GMRC("NMBR"))
DO AGAIN^GMRCSLMV(GMRC("NMBR"))
KILL GMRC("NMBR")
+16 IF '+$GET(GMRCSEL)
DO SEL
IF $SELECT($DATA(DTOUT):1,$DATA(DIROUT):1,$DATA(GMRCQUT):1,'+GMRCSEL:1,1:0)
KILL GMRCSEL
SET GMRCQUT=1
QUIT
+17 IF $SELECT(+GMRCSEL<1:1,GMRCSEL>BLK:1,1:0)
WRITE !,"Select a consult listed in the number range 1 to "_BLK
SET GMRCAGN=1
QUIT
+18 SET GMRCO=$ORDER(^TMP("GMRCR",$JOB,"CS","AD",GMRCSEL,GMRCSEL,0))
+19 IF '+GMRCO
Begin DoDot:2
+20 SET GMRCQUT=1
+21 WRITE !,$CHAR(7),"Select a consult by entering its listed number between 1 and "_LNCT_"."
+22 KILL GMRCO,GMRCSEL
End DoDot:2
+23 QUIT
End DoDot:1
if $DATA(GMRCQUT)
QUIT
if $DATA(GMRCAGN)
GOTO SELECT
+24 QUIT
+25 ;
SEL ;Select order number(s) exit: GMRCSEL
+1 IF $DATA(GMRC("NMBR"))
SET GMRCSEL=GMRC("NMBR")
QUIT
+2 IF '$DATA(^TMP("GMRCR",$JOB,"CS","AD"))
WRITE !,"No orders to select.",!
SET GMRCQUT=1
SET GMRCSEL=""
QUIT
+3 IF '$ORDER(^TMP("GMRCR",$JOB,"CS","AD"))
IF BLK=1
SET GMRCSEL=BLK
QUIT
+4 SET GMRCSEL=""
WRITE !,"CHOOSE No. 1-",BLK,": "
READ X:DTIME
if X="^^"
SET DIROUT=1
IF '$TEST!(X["^")
SET (DTOUT,GMRCQUT)=1
QUIT
+5 IF X["?"
DO SELHELP
GOTO SEL
+6 IF X=""
SET GMRCQUT=1
QUIT
+7 IF X'?.3N
WRITE $CHAR(7)," ?? Enter the number from the far left of the list."
GOTO SEL
+8 IF $SELECT(X>BLK:1,X<1:1,1:0)
DO SELHELP
GOTO SEL
+9 SET GMRCSEL=X
+10 QUIT
SELHELP ;Help to select a valid entry
+1 WRITE !,"Select a request by typing the number from the left column and pressing <ENTER>.",!
+2 QUIT
UP ;Convert lower to upper case entry: X exit: X
+1 FOR %=1:1:$LENGTH(X)
IF $EXTRACT(X,%)?1L
SET X=$EXTRACT(X,1,%-1)_$CHAR($ASCII(X,%)-32)_$EXTRACT(X,%+1,99)
+2 QUIT
