- 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 Feb 18, 2025@23:11:17 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
