HLCSFMN2 ;ALB/JRP - FILER MONITOR UTILITIES;13-FEB-95 ;10/15/99 07:16
;;1.6;HEALTH LEVEL SEVEN;**57**;Oct 13, 1995
;
SELECT(INARR,ENTITY) ;SELECTION UTILITY
;INPUT : INARR - Array whose first subscript denotes the list of
; selectable numbers (full global reference)
; - $O(INARR(x)) yields all selectable numbers
; ENTITY - What's being selected
; - Defaults to 'Entry' (prompt is 'Select Entry')
;OUTPUT : X - Number selected
; 0 - Nothing selected
; -1 - Bad input / nothing to select from
; -2 - Timeout / abort
;NOTES : User does not have to select an entry
; : Number selected will be validated (must be in INARR). This
; allows gaps to exist in INARR(x).
; : Only whole numbers greater than zero are selectable
;
;CHECK INPUT
Q:($G(INARR)="") -1
Q:('$O(@INARR@(0))) -1
S:($G(ENTITY)="") ENTITY="Entry"
;DECLARE VARIABLES
N DIR,X,Y,DTOUT,DUOUT,DIRUT,FRSTENT,LSTENT,LOOP,DONE
;DETERMINE FIRST AND LAST ENTRY NUMBERS
S FRSTENT=+$O(@INARR@(""))
S LSTENT=+$O(@INARR@(""),-1)
;ONLY ONE ITEM - AUTO SELECT
Q:(FRSTENT=LSTENT) FRSTENT
;PROMPT USER FOR VALID SELECTION
F DONE=0:0 D Q:(DONE)
.K DIR,DTOUT,DUOUT,DIRUT,X,Y
.S DIR(0)="NAO^"_FRSTENT_":"_LSTENT_":0"
.S DIR("A")="Select "_ENTITY_" ("_FRSTENT_"-"_LSTENT_"): "
.S DIR("?",1)="Response must be a number between "_FRSTENT_" and "_LSTENT
.S DIR("?")="Enter '??' to see a list of valid selections"
.S DIR("??")="^W !!,""Valid Selections: "" S LOOP=0 F S LOOP=+$O(@INARR@(LOOP)) Q:('LOOP) W:(LOOP'=FRSTENT) "","" W:(($X+$L(LOOP)+1)>79) !,?18 W LOOP"
.D ^DIR
.;TIMEOUT/ABORT
.I (($D(DTOUT))!($D(DUOUT))) S Y=-2,DONE=1 Q
.;NOTHING SELECTED
.I ($D(DIRUT)) S Y=0,DONE=1 Q
.;VALIDATE SELECTION
.I ($D(@INARR@(Y))) S DONE=1 Q
.;INVALID SELECTION
.W $C(7),!!,Y," is not a valid selection"
.W !,"Enter '??' to see a list of valid selections"
.W !
;DONE
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLCSFMN2 2000 printed Dec 13, 2024@01:56:30 Page 2
HLCSFMN2 ;ALB/JRP - FILER MONITOR UTILITIES;13-FEB-95 ;10/15/99 07:16
+1 ;;1.6;HEALTH LEVEL SEVEN;**57**;Oct 13, 1995
+2 ;
SELECT(INARR,ENTITY) ;SELECTION UTILITY
+1 ;INPUT : INARR - Array whose first subscript denotes the list of
+2 ; selectable numbers (full global reference)
+3 ; - $O(INARR(x)) yields all selectable numbers
+4 ; ENTITY - What's being selected
+5 ; - Defaults to 'Entry' (prompt is 'Select Entry')
+6 ;OUTPUT : X - Number selected
+7 ; 0 - Nothing selected
+8 ; -1 - Bad input / nothing to select from
+9 ; -2 - Timeout / abort
+10 ;NOTES : User does not have to select an entry
+11 ; : Number selected will be validated (must be in INARR). This
+12 ; allows gaps to exist in INARR(x).
+13 ; : Only whole numbers greater than zero are selectable
+14 ;
+15 ;CHECK INPUT
+16 if ($GET(INARR)="")
QUIT -1
+17 if ('$ORDER(@INARR@(0)))
QUIT -1
+18 if ($GET(ENTITY)="")
SET ENTITY="Entry"
+19 ;DECLARE VARIABLES
+20 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,FRSTENT,LSTENT,LOOP,DONE
+21 ;DETERMINE FIRST AND LAST ENTRY NUMBERS
+22 SET FRSTENT=+$ORDER(@INARR@(""))
+23 SET LSTENT=+$ORDER(@INARR@(""),-1)
+24 ;ONLY ONE ITEM - AUTO SELECT
+25 if (FRSTENT=LSTENT)
QUIT FRSTENT
+26 ;PROMPT USER FOR VALID SELECTION
+27 FOR DONE=0:0
Begin DoDot:1
+28 KILL DIR,DTOUT,DUOUT,DIRUT,X,Y
+29 SET DIR(0)="NAO^"_FRSTENT_":"_LSTENT_":0"
+30 SET DIR("A")="Select "_ENTITY_" ("_FRSTENT_"-"_LSTENT_"): "
+31 SET DIR("?",1)="Response must be a number between "_FRSTENT_" and "_LSTENT
+32 SET DIR("?")="Enter '??' to see a list of valid selections"
+33 SET DIR("??")="^W !!,""Valid Selections: "" S LOOP=0 F S LOOP=+$O(@INARR@(LOOP)) Q:('LOOP) W:(LOOP'=FRSTENT) "","" W:(($X+$L(LOOP)+1)>79) !,?18 W LOOP"
+34 DO ^DIR
+35 ;TIMEOUT/ABORT
+36 IF (($DATA(DTOUT))!($DATA(DUOUT)))
SET Y=-2
SET DONE=1
QUIT
+37 ;NOTHING SELECTED
+38 IF ($DATA(DIRUT))
SET Y=0
SET DONE=1
QUIT
+39 ;VALIDATE SELECTION
+40 IF ($DATA(@INARR@(Y)))
SET DONE=1
QUIT
+41 ;INVALID SELECTION
+42 WRITE $CHAR(7),!!,Y," is not a valid selection"
+43 WRITE !,"Enter '??' to see a list of valid selections"
+44 WRITE !
End DoDot:1
if (DONE)
QUIT
+45 ;DONE
+46 QUIT Y
