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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLEMP1 3542 printed Dec 13, 2024@01:57:27 Page 2
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
