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