source: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLEMP1.m@ 619

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

initial load of WorldVistAEHR

File size: 3.4 KB
Line 
1HLEMP1 ;ALB/CJM-HL7 - Selector for Events Log Profiles ;07/10/2003
2 ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13,1995
3 ;
4SELECT(USER,SCRNSIZE) ;
5 ;Input:
6 ; USER - the owner's DUZ
7 ; SCRNSIZE is the number of lines available for scrolling
8 ;Output;
9 ; function returns ien of profile if selection is made, 0 otherwise
10 ;
11 Q:'$G(USER) 0
12 I '$G(SCRNSIZE) S SCRNSIZE=10
13 S SCRNSIZE=+$G(SCRNSIZE)-1
14 S:SCRNSIZE<1 SCRNSIZE=1
15 N COUNT,CNT,PICK,PROFILE,ARY,NAME
16 S ARY="^TMP($J,""PROFILES"")"
17 K @ARY
18 S CNT=$$FINDALL(USER,ARY)
19 ;
20 ;return failure if no profiles found
21 Q:CNT=0 0
22 ;
23 ;if CNT=1 return the only profile
24 I CNT=1 S NAME=$O(@ARY@("NAME","")) Q $S(NAME'="":$O(@ARY@("NAME",NAME,0)),1:"")
25 ;
26 ;if CNT>1 loop through the profiles, displaying them to the user and let him choose
27 W !,"Please select the profile you wish to use"
28AGAIN ;
29 S (PICK,NAME)="",COUNT=0
30 F S NAME=$O(@ARY@("NAME",NAME)) Q:(PICK'="")!(NAME="") D
31 .S PROFILE=0 F S PROFILE=$O(@ARY@("NAME",NAME,PROFILE)) Q:(PICK'="")!('PROFILE) D Q:NAME=""
32 ..S COUNT=COUNT+1,@ARY@("#",COUNT)=PROFILE W !,COUNT," ",NAME
33 ..I COUNT#SCRNSIZE=0 S PICK=$$CHOOSE(ARY)
34 I (PICK=""),COUNT,COUNT#SCRNSIZE'=0 S PICK=$$CHOOSE(ARY)
35 I PICK="" K DIR S DIR(0)="Y",DIR("A")="No profile selected! Try again",DIR("B")="YES" D ^DIR K DIR I '$D(DIRUT),Y=1 G AGAIN
36 I PICK="?" G AGAIN
37 K @ARY
38 Q $S((PICK'>0):"",1:PICK)
39 ;
40FINDALL(USER,ARY) ;finds all of the profiles belonging to USER and puts them on @ARY,returns the count
41 N PROFILE,COUNT,NAME
42 S NAME="",COUNT=0 F S NAME=$O(^HLEV(776.5,"C",USER,NAME)) Q:'$L(NAME) S PROFILE=$O(^HLEV(776.5,"C",USER,NAME,0)) I PROFILE,$D(^HLEV(776.5,PROFILE,0)) S @ARY@("NAME",$$UP^XLFSTR(NAME),PROFILE)="",COUNT=COUNT+1
43 Q COUNT
44 ;
45CHOOSE(ARY) ;asks the user to select a profile - @ARY@("#", is the array of profiles displayed so far(subscripted by the number on the list), @ARY@("NAME", the entire array (subscripted by name,ien)
46 ;sets NAME to " " and COUNT to 0 if ? is entered - starts display of list over
47 N ANS,QUIT,PICK,NEXT1,NEXT2
48 S QUIT=0
49 F Q:QUIT D D:'QUIT MSG
50 .S (PICK,ANS)=""
51 .W !,"Choose 1-",COUNT,$S(COUNT<CNT:" or hit RETURN to see more",1:""),": "
52 .R ANS:DTIME
53 .I '$T!($E(ANS,1)="^") S PICK=-1,QUIT=1 Q
54 .I ANS="" S QUIT=1 Q
55 .I $E(ANS,1)="?" D HELP Q
56 .;
57 .;convert to upper case
58 .S ANS=$$UP^XLFSTR(ANS)
59 .
60 .;if user entered a displayed number then he's made his choice
61 .I $D(@ARY@("#",ANS)) S PICK=$G(@ARY@("#",ANS)),QUIT=1 Q
62 .;
63 .;if the user entered an exact name, and the name is unique then he's made his choice
64 .S PICK=$O(@ARY@("NAME",ANS,PICK)) I PICK,'$O(@ARY@("NAME",ANS,PICK)) S QUIT=1 Q
65 .Q:PICK ;don't set QUIT=1 because name is not unique
66 .;
67 .;if the user entered a partial name accept it if there is exactly one match
68 .S NEXT1=$O(@ARY@("NAME",ANS)) Q:(NEXT1="")!($E(NEXT1,1,$L(ANS))'=ANS)
69 .S NEXT2=$O(@ARY@("NAME",NEXT1)) Q:($E(NEXT2,1,$L(ANS))=ANS) ;because user did not type in enough to uniquely identify the profile
70 .;make sure there are not two profiles with the same name - if ok, accept it
71 .S PICK=$O(@ARY@("NAME",NEXT1,PICK)) Q:'PICK I '$O(@ARY@("NAME",NEXT1,PICK)) S QUIT=1 Q
72 Q PICK
73 ;
74HELP ;choosing help restarts the display (by setting NAME="")
75 W !,"You can choose a profile by the number or by it's name.",!
76 D PAUSE
77 S QUIT=1,NAME="",PICK="?",COUNT=0
78 Q
79MSG ;
80 W !,"You must enter the number or name of the profile!"
81 D PAUSE
82 Q
83PAUSE ;
84 N ANS
85 W !,$C(7),"Press RETURN to continue..." R ANS:DTIME
86 Q
Note: See TracBrowser for help on using the repository browser.