- HLEMP1 ;ALB/CJM-HL7 - Selector for Events Log Profiles ;07/10/2003
- ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13,1995
- ;
- SELECT(USER,SCRNSIZE) ;
- ;Input:
- ; USER - the owner's DUZ
- ; SCRNSIZE is the number of lines available for scrolling
- ;Output;
- ; function returns ien of profile if selection is made, 0 otherwise
- ;
- Q:'$G(USER) 0
- I '$G(SCRNSIZE) S SCRNSIZE=10
- S SCRNSIZE=+$G(SCRNSIZE)-1
- S:SCRNSIZE<1 SCRNSIZE=1
- N COUNT,CNT,PICK,PROFILE,ARY,NAME
- S ARY="^TMP($J,""PROFILES"")"
- K @ARY
- S CNT=$$FINDALL(USER,ARY)
- ;
- ;return failure if no profiles found
- Q:CNT=0 0
- ;
- ;if CNT=1 return the only profile
- I CNT=1 S NAME=$O(@ARY@("NAME","")) Q $S(NAME'="":$O(@ARY@("NAME",NAME,0)),1:"")
- ;
- ;if CNT>1 loop through the profiles, displaying them to the user and let him choose
- W !,"Please select the profile you wish to use"
- AGAIN ;
- S (PICK,NAME)="",COUNT=0
- F S NAME=$O(@ARY@("NAME",NAME)) Q:(PICK'="")!(NAME="") D
- .S PROFILE=0 F S PROFILE=$O(@ARY@("NAME",NAME,PROFILE)) Q:(PICK'="")!('PROFILE) D Q:NAME=""
- ..S COUNT=COUNT+1,@ARY@("#",COUNT)=PROFILE W !,COUNT," ",NAME
- ..I COUNT#SCRNSIZE=0 S PICK=$$CHOOSE(ARY)
- I (PICK=""),COUNT,COUNT#SCRNSIZE'=0 S PICK=$$CHOOSE(ARY)
- 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
- I PICK="?" G AGAIN
- K @ARY
- Q $S((PICK'>0):"",1:PICK)
- ;
- FINDALL(USER,ARY) ;finds all of the profiles belonging to USER and puts them on @ARY,returns the count
- N PROFILE,COUNT,NAME
- 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
- Q COUNT
- ;
- CHOOSE(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)
- ;sets NAME to " " and COUNT to 0 if ? is entered - starts display of list over
- N ANS,QUIT,PICK,NEXT1,NEXT2
- S QUIT=0
- F Q:QUIT D D:'QUIT MSG
- .S (PICK,ANS)=""
- .W !,"Choose 1-",COUNT,$S(COUNT<CNT:" or hit RETURN to see more",1:""),": "
- .R ANS:DTIME
- .I '$T!($E(ANS,1)="^") S PICK=-1,QUIT=1 Q
- .I ANS="" S QUIT=1 Q
- .I $E(ANS,1)="?" D HELP Q
- .;
- .;convert to upper case
- .S ANS=$$UP^XLFSTR(ANS)
- .
- .;if user entered a displayed number then he's made his choice
- .I $D(@ARY@("#",ANS)) S PICK=$G(@ARY@("#",ANS)),QUIT=1 Q
- .;
- .;if the user entered an exact name, and the name is unique then he's made his choice
- .S PICK=$O(@ARY@("NAME",ANS,PICK)) I PICK,'$O(@ARY@("NAME",ANS,PICK)) S QUIT=1 Q
- .Q:PICK ;don't set QUIT=1 because name is not unique
- .;
- .;if the user entered a partial name accept it if there is exactly one match
- .S NEXT1=$O(@ARY@("NAME",ANS)) Q:(NEXT1="")!($E(NEXT1,1,$L(ANS))'=ANS)
- .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
- .;make sure there are not two profiles with the same name - if ok, accept it
- .S PICK=$O(@ARY@("NAME",NEXT1,PICK)) Q:'PICK I '$O(@ARY@("NAME",NEXT1,PICK)) S QUIT=1 Q
- Q PICK
- ;
- HELP ;choosing help restarts the display (by setting NAME="")
- W !,"You can choose a profile by the number or by it's name.",!
- D PAUSE
- S QUIT=1,NAME="",PICK="?",COUNT=0
- Q
- MSG ;
- W !,"You must enter the number or name of the profile!"
- D PAUSE
- Q
- PAUSE ;
- N ANS
- W !,$C(7),"Press RETURN to continue..." R ANS:DTIME
- Q
- HLEMP1 ;ALB/CJM-HL7 - Selector for Events Log Profiles ;07/10/2003
- +1 ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13,1995
- +2 ;
- SELECT(USER,SCRNSIZE) ;
- +1 ;Input:
- +2 ; USER - the owner's DUZ
- +3 ; SCRNSIZE is the number of lines available for scrolling
- +4 ;Output;
- +5 ; function returns ien of profile if selection is made, 0 otherwise
- +6 ;
- +7 IF '$GET(USER)
- QUIT 0
- +8 IF '$GET(SCRNSIZE)
- SET SCRNSIZE=10
- +9 SET SCRNSIZE=+$GET(SCRNSIZE)-1
- +10 IF SCRNSIZE<1
- SET SCRNSIZE=1
- +11 NEW COUNT,CNT,PICK,PROFILE,ARY,NAME
- +12 SET ARY="^TMP($J,""PROFILES"")"
- +13 KILL @ARY
- +14 SET CNT=$$FINDALL(USER,ARY)
- +15 ;
- +16 ;return failure if no profiles found
- +17 IF CNT=0
- QUIT 0
- +18 ;
- +19 ;if CNT=1 return the only profile
- +20 IF CNT=1
- SET NAME=$ORDER(@ARY@("NAME",""))
- QUIT $SELECT(NAME'="":$ORDER(@ARY@("NAME",NAME,0)),1:"")
- +21 ;
- +22 ;if CNT>1 loop through the profiles, displaying them to the user and let him choose
- +23 WRITE !,"Please select the profile you wish to use"
- AGAIN ;
- +1 SET (PICK,NAME)=""
- SET COUNT=0
- +2 FOR
- SET NAME=$ORDER(@ARY@("NAME",NAME))
- IF (PICK'="")!(NAME="")
- QUIT
- Begin DoDot:1
- +3 SET PROFILE=0
- FOR
- SET PROFILE=$ORDER(@ARY@("NAME",NAME,PROFILE))
- IF (PICK'="")!('PROFILE)
- QUIT
- Begin DoDot:2
- +4 SET COUNT=COUNT+1
- SET @ARY@("#",COUNT)=PROFILE
- WRITE !,COUNT," ",NAME
- +5 IF COUNT#SCRNSIZE=0
- SET PICK=$$CHOOSE(ARY)
- End DoDot:2
- IF NAME=""
- QUIT
- End DoDot:1
- +6 IF (PICK="")
- IF COUNT
- IF COUNT#SCRNSIZE'=0
- SET PICK=$$CHOOSE(ARY)
- +7 IF PICK=""
- KILL DIR
- SET DIR(0)="Y"
- SET DIR("A")="No profile selected! Try again"
- SET DIR("B")="YES"
- DO ^DIR
- KILL DIR
- IF '$DATA(DIRUT)
- IF Y=1
- GOTO AGAIN
- +8 IF PICK="?"
- GOTO AGAIN
- +9 KILL @ARY
- +10 QUIT $SELECT((PICK'>0):"",1:PICK)
- +11 ;
- FINDALL(USER,ARY) ;finds all of the profiles belonging to USER and puts them on @ARY,returns the count
- +1 NEW PROFILE,COUNT,NAME
- +2 SET NAME=""
- SET COUNT=0
- FOR
- SET NAME=$ORDER(^HLEV(776.5,"C",USER,NAME))
- IF '$LENGTH(NAME)
- QUIT
- SET PROFILE=$ORDER(^HLEV(776.5,"C",USER,NAME,0))
- IF PROFILE
- IF $DATA(^HLEV(776.5,PROFILE,0))
- SET @ARY@("NAME",$$UP^XLFSTR(NAME),PROFILE)=""
- SET COUNT=COUNT+1
- +3 QUIT COUNT
- +4 ;
- CHOOSE(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)
- +1 ;sets NAME to " " and COUNT to 0 if ? is entered - starts display of list over
- +2 NEW ANS,QUIT,PICK,NEXT1,NEXT2
- +3 SET QUIT=0
- +4 FOR
- IF QUIT
- QUIT
- Begin DoDot:1
- +5 SET (PICK,ANS)=""
- +6 WRITE !,"Choose 1-",COUNT,$SELECT(COUNT<CNT:" or hit RETURN to see more",1:""),": "
- +7 READ ANS:DTIME
- +8 IF '$TEST!($EXTRACT(ANS,1)="^")
- SET PICK=-1
- SET QUIT=1
- QUIT
- +9 IF ANS=""
- SET QUIT=1
- QUIT
- +10 IF $EXTRACT(ANS,1)="?"
- DO HELP
- QUIT
- +11 ;
- +12 ;convert to upper case
- +13 SET ANS=$$UP^XLFSTR(ANS)
- +14 +15 ;if user entered a displayed number then he's made his choice
- +16 IF $DATA(@ARY@("#",ANS))
- SET PICK=$GET(@ARY@("#",ANS))
- SET QUIT=1
- QUIT
- +17 ;
- +18 ;if the user entered an exact name, and the name is unique then he's made his choice
- +19 SET PICK=$ORDER(@ARY@("NAME",ANS,PICK))
- IF PICK
- IF '$ORDER(@ARY@("NAME",ANS,PICK))
- SET QUIT=1
- QUIT
- +20 ;don't set QUIT=1 because name is not unique
- IF PICK
- QUIT
- +21 ;
- +22 ;if the user entered a partial name accept it if there is exactly one match
- +23 SET NEXT1=$ORDER(@ARY@("NAME",ANS))
- IF (NEXT1="")!($EXTRACT(NEXT1,1,$LENGTH(ANS))'=ANS)
- QUIT
- +24 ;because user did not type in enough to uniquely identify the profile
- SET NEXT2=$ORDER(@ARY@("NAME",NEXT1))
- IF ($EXTRACT(NEXT2,1,$LENGTH(ANS))=ANS)
- QUIT
- +25 ;make sure there are not two profiles with the same name - if ok, accept it
- +26 SET PICK=$ORDER(@ARY@("NAME",NEXT1,PICK))
- IF 'PICK
- QUIT
- IF '$ORDER(@ARY@("NAME",NEXT1,PICK))
- SET QUIT=1
- QUIT
- End DoDot:1
- IF 'QUIT
- DO MSG
- +27 QUIT PICK
- +28 ;
- HELP ;choosing help restarts the display (by setting NAME="")
- +1 WRITE !,"You can choose a profile by the number or by it's name.",!
- +2 DO PAUSE
- +3 SET QUIT=1
- SET NAME=""
- SET PICK="?"
- SET COUNT=0
- +4 QUIT
- MSG ;
- +1 WRITE !,"You must enter the number or name of the profile!"
- +2 DO PAUSE
- +3 QUIT
- PAUSE ;
- +1 NEW ANS
- +2 WRITE !,$CHAR(7),"Press RETURN to continue..."
- READ ANS:DTIME
- +3 QUIT