HLEMP1.m

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