XUXTADASK1 ;ESL/JAC/CM - UTL Reusable prompting subroutines #1 ; 06/26/2020@9:30
;;8.0;KERNEL;**807**;Oct 16, 2024;Build 56;
;
;
; External API'S
;
; XUXTAD API's
CENTER(AXUXTADTEXT,AXUXTADLF,AXUXTADRM,AXUXTADRVIDEO) D CENTER^XUXTADPRT1($G(AXUXTADTEXT),$G(AXUXTADLF),$G(AXUXTADRM),$G(AXUXTADRVIDEO)) Q
;
; FileMan/ScreenMan API's
FMDIR D ^DIR Q
;
;-- Integration Control Registrations
; Reference to ^DIR in ICR #10026
;
ASKLIST(XUXTADOUTPUT,XUXTADINPUT,XUXTADMAXNUM,XUXTADDEF) ; Prompt the user to 'Select NUMBER(S): '.
; The XUXTADOUTPUT and INPUT parameters must be passed by reference and are
; limited to local un-subscripted arrays. Each of the local array variable
; names must be prefixed in the actual parameter list of the calling routine's
; DO command with a period. See the example provided below which was provided
; as a reference.
;
; Input:
; XUXTADOUTPUT ; Required - The programmer selected name for the output
; array prefixed by a period. This implies that this label
; should be called by reference not by value.
; Examples: .USER ; .DOMAIN ; .LOCATION .SETOFCDS ; etc.
; XUXTADINPUT ; Required - A period followed by the programmer name of
; the array from the calling routine in the following format:
; XUXTADINPUT(SequenceNUM)=code_"^"_VALUE
; XUXTADMAXNUM ; Required - Maximum number of input choices
; XUXTADDEF ; Optional - Default answer to DIR("B") prompt
; Output:
; XUXTADOUTPUT=User's typed selection.
; Examples: 1,4-6 ; 1,3 ; 1-9 ; 6 ; "^" ; etc.
; XUXTADOUTPUT(code)=VALUE
; Where code is one of the following:
; 1) Integer ; or
; 2) Internal code of a set of codes ; or
; 3) IEN (Pointer or internal entry number to some file)
; code will be derived from the value of piece one of the XUXTADINPUT
; array parameter.
; XUXTADOUTPUT("CNT")=NumberOfPossibleListChoices
; XUXTADQUIT 1 - User entered '^' to quit or no items were selected by the user.
; 0 - Indicates a successful API call and response.
; Note: XUXTADOUTPUT and XUXTADINPUT are arrays passed by reference.
;
NEW %,DA,DIR,DIRUT,DTOUT,DUOUT,I,X,Y,XUXTADCODE,XUXTADNUM,XUXTADPCE,XUXTADVALUE
;
KILL XUXTADOUTPUT ; Refresh output array
S XUXTADQUIT=0 ;. Initialize output status flag to successful
;
; Setup input variables to DIR call
S DIR(0)="LAO^1:"_XUXTADMAXNUM ;....... User may select list or range
S DIR("A")="Select NUMBER(S): " ; Set text of prompt
I $G(XUXTADDEF)]"" S DIR("B")=XUXTADDEF ;.... Optionally set prompt default value
D FMDIR ; Prompt user
;
S XUXTADOUTPUT=X ; Return user's selection in XUXTADOUTPUT
S XUXTADOUTPUT("CNT")=XUXTADMAXNUM ; Number of choices in prompt list
I "^"[X S XUXTADQUIT=1 Q ; Set status to unsuccessful on '^'
;
; Process user's list of choices (comma delimited output by ^DIR)
; Example Y="1,3,7,9,"
; and store them in the XUXTADOUTPUT(XUXTADCODE)=VALUE array
;
S XUXTADNUM=""
F XUXTADPCE=1:1 S XUXTADNUM=$P(Y,",",XUXTADPCE) Q:'XUXTADNUM D ;
. S XUXTADCODE=$P(XUXTADINPUT(XUXTADNUM),U,1),XUXTADVALUE=$P(XUXTADINPUT(XUXTADNUM),U,2)
. S XUXTADOUTPUT(XUXTADCODE)=XUXTADVALUE
I '$O(XUXTADOUTPUT(""))']"" S XUXTADQUIT=1 Q ; No choice made by user
Q ; ASKLIST
;
ASKNUM(XUXTADMAXNUM,XUXTADDEF,XUXTADPROMPT,XUXTADLINFED) ; Extrinsic to prompt from 1 to XUXTADMAXNUM
; Input:
; XUXTADMAXNUM Optional - Maximum number of input choices
; XUXTADDEF Optional - Default response (if user hits <Enter> key)
; XUXTADPROMPT Optional - Input prompt text, for example:
; "How many days? 90//" ; when XUXTADDEF = 90
; XUXTADLINFED Optional - Number of linefeeds before prompting user
; (defaults to 1, if not passed)
; Output:
; User's response (Usually an integer, could be '^' or null)
; Note: The calling routine should check for '^' response.
;
NEW XUXTADCNT,XUXTADRESPONSE
S XUXTADMAXNUM=$G(XUXTADMAXNUM) ; There is not a default maximum number set
S XUXTADDEF=$G(XUXTADDEF) ; There is no default response to the prompt, unless the default is passed.
S XUXTADPROMPT=$G(XUXTADPROMPT,"Select NUMBER")
S XUXTADPROMPT=XUXTADPROMPT_$S(XUXTADMAXNUM<2:": ",1:"(1-"_XUXTADMAXNUM_"): ")
S XUXTADLINFED=$G(XUXTADLINFED,1)
F XUXTADCNT=1:1:XUXTADLINFED W ! ; Issue number of linefeeds based on XUXTADLINFED variable
;
ASKNUM1 ; Return to this label upon receiving an incorrect response
W XUXTADPROMPT I XUXTADDEF]"" W XUXTADDEF_"// "
R XUXTADRESPONSE:DTIME I XUXTADRESPONSE="",XUXTADDEF="" S XUXTADRESPONSE="^"
S:$T XUXTADRESPONSE="^"
I XUXTADDEF]"",XUXTADRESPONSE="" S XUXTADRESPONSE=XUXTADDEF
I "^"[XUXTADRESPONSE QUIT XUXTADRESPONSE
I XUXTADRESPONSE'?1.20N!(XUXTADRESPONSE<1)!((XUXTADRESPONSE>XUXTADMAXNUM)&(XUXTADMAXNUM>1)) D G ASKNUM1
. Q:XUXTADMAXNUM'>1
. I XUXTADMAXNUM>1 D Q ;
. . W $C(7)," Enter a number from 1 to "_$FN(XUXTADMAXNUM,",")_" or '^' to exit."
. . W !
. W $C(7)," Enter a positive integer (1, 2, etc.); or '^' to exit."
. W !
Q XUXTADRESPONSE ; ASKNUM
;
ASKPKG(XUXTADPROMPT) ; Prompt for 2-7 character Package NAMESPACE
; Input:
; XUXTADPROMPT Optional - Text for input prompt - for example: "Enter NAMESPACE: "
; Output:
; XUXTADPKG Chosen namespace (2 to 7 characters)
; XUXTADQUIT 0 - If a successful package namespace was entered.
; 1 - If prompt times out; user enters an '^' or the user simply hits
; <Enter> without answering.
NEW XUXTADASCII,XUXTADPOS
;
ASKPKG1 ; Return to this label upon receiving an incorrect response
S XUXTADQUIT=0 ; Initialize quit status flag to 0 (or do not quit)
S XUXTADPROMPT=$G(XUXTADPROMPT,"Which 2-7 character Package NAMESPACE: ")
;
; Prompt for Package NAMESPACE, quit if user timed out,
; no entry was made, or an '^' was entered
;
W !!,XUXTADPROMPT
; If user times out or enters a '^' to exit, set XUXTADQUIT=1
R XUXTADPKG:DTIME I '$T!("^"[XUXTADPKG) S XUXTADQUIT=1 Q
;
; Test each character entered, do NOT allow lowercase characters
; and the first character should be alphabetic (or %).
;
F XUXTADPOS=1:1 Q:XUXTADPOS>$L(XUXTADPKG)!XUXTADQUIT D ;
. I XUXTADPOS=1,"%ABCDEFGHIJKLMNOPQRSTUVWXYZ"'[$E(XUXTADPKG) D Q
. . S XUXTADQUIT=1 ; 1st character must be % or alphabetic
. S XUXTADASCII=$A($E(XUXTADPKG,XUXTADPOS,XUXTADPOS)) ; ASCII character representation
. I "0123456789"'[$E(XUXTADPKG,XUXTADPOS,XUXTADPOS),XUXTADASCII>96,XUXTADASCII<123 D ;
. . S XUXTADQUIT=1 ; Non-alphabetic or numeric char. found
;
I XUXTADPKG["?"!(XUXTADPKG="")!($L(XUXTADPKG)<2)!($L(XUXTADPKG)>7) D ;
. S XUXTADQUIT=1 ; Namespace must be 2 to 7 characters
;
I XUXTADQUIT D ERRMSG1,ERRMSG2 G ASKPKG1
Q ; ASKPKG
;
ASKYESNO(XUXTADPROMPT,XUXTADDEF) ; Extrinsic, prompt for YES, NO response
; Input:
; XUXTADPROMPT Optional - Text of prompt....input to DIR("A")
; XUXTADDEF Optional - Default response..input to DIR("B")
; will be "NO" if not passed on input
; Output: Y (for YES), N (for NO), or '^"
; Intended use:
; This API call was developed as a standardized wrapper call
; to the FM DIR utility when a YES or NO response is required.
; Note: The calling routine will be responsible for checking for a
; '^' response as shown in the example calls below.
;
NEW %,DA,DIR,DIRUT,DTOUT,DUOUT,I,X,Y
S XUXTADPROMPT=$G(XUXTADPROMPT) ; Default response to "NO" if not passed
S XUXTADDEF=$G(XUXTADDEF,"NO")
;
;S (DIR("?"),DIR("??"))="Enter 'Y' (for YES), 'N' (for NO), or '^' (to exit)"
S DIR("?")="Enter 'Y' (for YES), 'N' (for NO), or '^' (to exit)"
S DIR(0)="Y",DIR("A")=XUXTADPROMPT
I XUXTADDEF]"" S DIR("B")=XUXTADDEF
;
D FMDIR
I "^"[Y!(Y["^") Q "^"
I Y=1 Q "Y"
I Y=0 Q "N"
Q "N" ; ASKYESNO
;
ERRMSG1 ; Package NAMESPACE requirements were NOT met.
I XUXTADPKG'["?" W " ??"
W !!?6,"Enter the first 2 to 7 characters of the Package NAMESPACE, or"
W !?6,"enter an '^' to exit."
W !!?6,"The first character must be an alphabetic or % character, followed by"
W !?6,"any alphanumeric combination, however, all alphabetic characters"
W !?6,"must be in uppercase with no lowercase characters allowed."
Q ; ERRMSG1
;
ERRMSG2 ; <CAPS LOCK> key if not on.
D CENTER("Make sure your <CAPS LOCK> key is on.",2,IOM,1)
Q ; ERRMSG2
;
GETKEYWD(XUXTADMINLEN,XUXTADMAXLEN) ; Prompt for KEYWORD
; Input:
; XUXTADMINLEN Required - Minimum length of KEYWORD specification
; XUXTADMAXLEN Required - Maximum length of KEYWORD specification
; XUXTADKEYWRD Required - externally defined, returned to caller.
; Output:
; XUXTADKEYWRD Keyword to be used later for screening output records
; (or user's response which could be null or "^")
; XUXTADQUIT 0 - Keyword successfully chosen
; 1 - User entered '^' or no keyword was chosen
;
NEW XUXTADPOS
W !
GETKEY1 ; Return to this label upon receiving an incorrect response
;
W !,"Select a KEYWORD (from "_XUXTADMINLEN_" to "_XUXTADMAXLEN_" characters): "
S XUXTADQUIT=0 ; Do not quit when returning to the calling module
;
R XUXTADKEYWRD:DTIME S:'$T XUXTADKEYWRD="^"
I XUXTADKEYWRD="" S XUXTADQUIT=1 Q ; No keyword found
I XUXTADKEYWRD["^" S XUXTADQUIT=1 Q ;User entered an '^'
I $L(XUXTADKEYWRD)<XUXTADMINLEN!($L(XUXTADKEYWRD)>XUXTADMAXLEN) W " ??" G GETKEY1
F XUXTADPOS=1:1:$L(XUXTADKEYWRD) D I XUXTADQUIT G GETKEY1
. ; Verify that the Keyword is in uppercase format.
. I $A($E(XUXTADKEYWRD,XUXTADPOS,XUXTADPOS))>96,$A($E(XUXTADKEYWRD,XUXTADPOS,XUXTADPOS))<123 D ;
. . NEW XUXTADMSG
. . S XUXTADMSG="Make sure <Caps Lock> key in on and re-enter your keyword"
. . D CENTER(XUXTADMSG,1,IOM,1)
. . S XUXTADQUIT=1 ; Keyword entered is not all uppercase chars.
Q ; GETKEYWD
;
GETSORT(XUXTADRTN,XUXTADINPUT,XUXTADDEF) ; Get sorting criteria (generic subroutine call)
; Input:
; XUXTADRTN..... ; Required - Name of calling routine, typically $T(+0)
; XUXTADINPUT(n)=Sorting_Option - Required
; Where XUXTADINPUT represents the name of the input array, and n is a
; consecutive integer from 1 to the (n)umber of sorting options presented
; The input array name is passed by reference and any local array
; name can be used, although passing '.XUXTADSORT' is preferred
; which then allows the calling routine to utilize the user
; selected sorting option to be referenced as XUXTADSORT(XUXTADSORT).
; This also minimizes the number of variables that would have to
; be NEWed by the calling routine.
; XUXTADDEF Optional - Default integer response to prompt.
; Defaults to 1 if not passed
; If XUXTADDEF is passed and XUXTADINPUT(XUXTADDEF) exists, then XUXTADDEF
; becomes the default integer response allowing the
; developer to always override other previous default responses.
; Output:
; XUXTADSORT Integer representing user's sorting choice
; XUXTADQUIT Set to 1 if the user up-arrows out, otherwise 0.
;
NEW XUXTADCNT,XUXTADPOS,XUXTADRESPONSE
;
; Set default response to input prompt in variable XUXTADDEF
;
I $G(XUXTADDEF)>0,$D(XUXTADINPUT(XUXTADDEF)) S XUXTADDEF=XUXTADDEF
E S XUXTADDEF=1
S XUXTADQUIT=0 ; Do not quit when returning to the calling module
;
W !!,"Sort by"
F XUXTADCNT=1:1 Q:'$D(XUXTADINPUT(XUXTADCNT)) D ;
. S XUXTADPOS=$S($L(XUXTADCNT)>9:$L(XUXTADCNT),1:2) ; Horizontal print position
. W !?XUXTADPOS,$J(XUXTADCNT,2),") ",XUXTADINPUT(XUXTADCNT)
S XUXTADCNT=XUXTADCNT-1
;
S XUXTADRESPONSE=$$ASKNUM(XUXTADCNT,XUXTADDEF) I XUXTADRESPONSE="" S XUXTADRESPONSE=XUXTADDEF
I XUXTADRESPONSE["^" S XUXTADQUIT=1 Q ; User entered an '^'
;
S XUXTADINPUT=XUXTADRESPONSE ;;02020-03-09 update
S XUXTADSORT=XUXTADRESPONSE
Q ; GETSORT
;
USRLIMIT(XUXTADRTN) ; Include (active users, inactive users, or both active and inactive users)
; Output:
; XUXTADULIMIT 1 for both active & inactive users
; 2 for active users
; 3 for inactive users
; XUXTADQUIT 0 - for successful selection at prompt
; 1 - if user enters an '^' to exit at prompt
; Input:
; XUXTADRTN Required - Name of calling routine; usually $T(+0)
;
NEW XUXTADDEF
;
S XUXTADDEF=1
;
W !!,"Include"
W !?4,"1) Both active and inactive users"
W !?4,"2) Only active users"
W !?4,"3) Only inactive users"
;
S XUXTADULIMIT=$$ASKNUM(3,XUXTADDEF)
I XUXTADULIMIT="^" S XUXTADQUIT=1 Q ; User entered an '^'
;
S XUXTADQUIT=0 ; Do not quit when returning to the calling module
Q ; USRLIMIT
;
;XUXTADASK1 ;ESL/JAC/cm - UTL Reusable prompting subroutines #1 ; 06/26/2020 09:30
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUXTADASK1 12969 printed Sep 23, 2025@19:50:33 Page 2
XUXTADASK1 ;ESL/JAC/CM - UTL Reusable prompting subroutines #1 ; 06/26/2020@9:30
+1 ;;8.0;KERNEL;**807**;Oct 16, 2024;Build 56;
+2 ;
+3 ;
+4 ; External API'S
+5 ;
+6 ; XUXTAD API's
CENTER(AXUXTADTEXT,AXUXTADLF,AXUXTADRM,AXUXTADRVIDEO) DO CENTER^XUXTADPRT1($GET(AXUXTADTEXT),$GET(AXUXTADLF),$GET(AXUXTADRM),$GET(AXUXTADRVIDEO))
QUIT
+1 ;
+2 ; FileMan/ScreenMan API's
FMDIR DO ^DIR
QUIT
+1 ;
+2 ;-- Integration Control Registrations
+3 ; Reference to ^DIR in ICR #10026
+4 ;
ASKLIST(XUXTADOUTPUT,XUXTADINPUT,XUXTADMAXNUM,XUXTADDEF) ; Prompt the user to 'Select NUMBER(S): '.
+1 ; The XUXTADOUTPUT and INPUT parameters must be passed by reference and are
+2 ; limited to local un-subscripted arrays. Each of the local array variable
+3 ; names must be prefixed in the actual parameter list of the calling routine's
+4 ; DO command with a period. See the example provided below which was provided
+5 ; as a reference.
+6 ;
+7 ; Input:
+8 ; XUXTADOUTPUT ; Required - The programmer selected name for the output
+9 ; array prefixed by a period. This implies that this label
+10 ; should be called by reference not by value.
+11 ; Examples: .USER ; .DOMAIN ; .LOCATION .SETOFCDS ; etc.
+12 ; XUXTADINPUT ; Required - A period followed by the programmer name of
+13 ; the array from the calling routine in the following format:
+14 ; XUXTADINPUT(SequenceNUM)=code_"^"_VALUE
+15 ; XUXTADMAXNUM ; Required - Maximum number of input choices
+16 ; XUXTADDEF ; Optional - Default answer to DIR("B") prompt
+17 ; Output:
+18 ; XUXTADOUTPUT=User's typed selection.
+19 ; Examples: 1,4-6 ; 1,3 ; 1-9 ; 6 ; "^" ; etc.
+20 ; XUXTADOUTPUT(code)=VALUE
+21 ; Where code is one of the following:
+22 ; 1) Integer ; or
+23 ; 2) Internal code of a set of codes ; or
+24 ; 3) IEN (Pointer or internal entry number to some file)
+25 ; code will be derived from the value of piece one of the XUXTADINPUT
+26 ; array parameter.
+27 ; XUXTADOUTPUT("CNT")=NumberOfPossibleListChoices
+28 ; XUXTADQUIT 1 - User entered '^' to quit or no items were selected by the user.
+29 ; 0 - Indicates a successful API call and response.
+30 ; Note: XUXTADOUTPUT and XUXTADINPUT are arrays passed by reference.
+31 ;
+32 NEW %,DA,DIR,DIRUT,DTOUT,DUOUT,I,X,Y,XUXTADCODE,XUXTADNUM,XUXTADPCE,XUXTADVALUE
+33 ;
+34 ; Refresh output array
KILL XUXTADOUTPUT
+35 ;. Initialize output status flag to successful
SET XUXTADQUIT=0
+36 ;
+37 ; Setup input variables to DIR call
+38 ;....... User may select list or range
SET DIR(0)="LAO^1:"_XUXTADMAXNUM
+39 ; Set text of prompt
SET DIR("A")="Select NUMBER(S): "
+40 ;.... Optionally set prompt default value
IF $GET(XUXTADDEF)]""
SET DIR("B")=XUXTADDEF
+41 ; Prompt user
DO FMDIR
+42 ;
+43 ; Return user's selection in XUXTADOUTPUT
SET XUXTADOUTPUT=X
+44 ; Number of choices in prompt list
SET XUXTADOUTPUT("CNT")=XUXTADMAXNUM
+45 ; Set status to unsuccessful on '^'
IF "^"[X
SET XUXTADQUIT=1
QUIT
+46 ;
+47 ; Process user's list of choices (comma delimited output by ^DIR)
+48 ; Example Y="1,3,7,9,"
+49 ; and store them in the XUXTADOUTPUT(XUXTADCODE)=VALUE array
+50 ;
+51 SET XUXTADNUM=""
+52 ;
FOR XUXTADPCE=1:1
SET XUXTADNUM=$PIECE(Y,",",XUXTADPCE)
if 'XUXTADNUM
QUIT
Begin DoDot:1
+53 SET XUXTADCODE=$PIECE(XUXTADINPUT(XUXTADNUM),U,1)
SET XUXTADVALUE=$PIECE(XUXTADINPUT(XUXTADNUM),U,2)
+54 SET XUXTADOUTPUT(XUXTADCODE)=XUXTADVALUE
End DoDot:1
+55 ; No choice made by user
IF '$ORDER(XUXTADOUTPUT(""))']""
SET XUXTADQUIT=1
QUIT
+56 ; ASKLIST
QUIT
+57 ;
ASKNUM(XUXTADMAXNUM,XUXTADDEF,XUXTADPROMPT,XUXTADLINFED) ; Extrinsic to prompt from 1 to XUXTADMAXNUM
+1 ; Input:
+2 ; XUXTADMAXNUM Optional - Maximum number of input choices
+3 ; XUXTADDEF Optional - Default response (if user hits <Enter> key)
+4 ; XUXTADPROMPT Optional - Input prompt text, for example:
+5 ; "How many days? 90//" ; when XUXTADDEF = 90
+6 ; XUXTADLINFED Optional - Number of linefeeds before prompting user
+7 ; (defaults to 1, if not passed)
+8 ; Output:
+9 ; User's response (Usually an integer, could be '^' or null)
+10 ; Note: The calling routine should check for '^' response.
+11 ;
+12 NEW XUXTADCNT,XUXTADRESPONSE
+13 ; There is not a default maximum number set
SET XUXTADMAXNUM=$GET(XUXTADMAXNUM)
+14 ; There is no default response to the prompt, unless the default is passed.
SET XUXTADDEF=$GET(XUXTADDEF)
+15 SET XUXTADPROMPT=$GET(XUXTADPROMPT,"Select NUMBER")
+16 SET XUXTADPROMPT=XUXTADPROMPT_$SELECT(XUXTADMAXNUM<2:": ",1:"(1-"_XUXTADMAXNUM_"): ")
+17 SET XUXTADLINFED=$GET(XUXTADLINFED,1)
+18 ; Issue number of linefeeds based on XUXTADLINFED variable
FOR XUXTADCNT=1:1:XUXTADLINFED
WRITE !
+19 ;
ASKNUM1 ; Return to this label upon receiving an incorrect response
+1 WRITE XUXTADPROMPT
IF XUXTADDEF]""
WRITE XUXTADDEF_"// "
+2 READ XUXTADRESPONSE:DTIME
IF XUXTADRESPONSE=""
IF XUXTADDEF=""
SET XUXTADRESPONSE="^"
+3 if $TEST
SET XUXTADRESPONSE="^"
+4 IF XUXTADDEF]""
IF XUXTADRESPONSE=""
SET XUXTADRESPONSE=XUXTADDEF
+5 IF "^"[XUXTADRESPONSE
QUIT XUXTADRESPONSE
+6 IF XUXTADRESPONSE'?1.20N!(XUXTADRESPONSE<1)!((XUXTADRESPONSE>XUXTADMAXNUM)&(XUXTADMAXNUM>1))
Begin DoDot:1
+7 if XUXTADMAXNUM'>1
QUIT
+8 ;
IF XUXTADMAXNUM>1
Begin DoDot:2
+9 WRITE $CHAR(7)," Enter a number from 1 to "_$FNUMBER(XUXTADMAXNUM,",")_" or '^' to exit."
+10 WRITE !
End DoDot:2
QUIT
+11 WRITE $CHAR(7)," Enter a positive integer (1, 2, etc.); or '^' to exit."
+12 WRITE !
End DoDot:1
GOTO ASKNUM1
+13 ; ASKNUM
QUIT XUXTADRESPONSE
+14 ;
ASKPKG(XUXTADPROMPT) ; Prompt for 2-7 character Package NAMESPACE
+1 ; Input:
+2 ; XUXTADPROMPT Optional - Text for input prompt - for example: "Enter NAMESPACE: "
+3 ; Output:
+4 ; XUXTADPKG Chosen namespace (2 to 7 characters)
+5 ; XUXTADQUIT 0 - If a successful package namespace was entered.
+6 ; 1 - If prompt times out; user enters an '^' or the user simply hits
+7 ; <Enter> without answering.
+8 NEW XUXTADASCII,XUXTADPOS
+9 ;
ASKPKG1 ; Return to this label upon receiving an incorrect response
+1 ; Initialize quit status flag to 0 (or do not quit)
SET XUXTADQUIT=0
+2 SET XUXTADPROMPT=$GET(XUXTADPROMPT,"Which 2-7 character Package NAMESPACE: ")
+3 ;
+4 ; Prompt for Package NAMESPACE, quit if user timed out,
+5 ; no entry was made, or an '^' was entered
+6 ;
+7 WRITE !!,XUXTADPROMPT
+8 ; If user times out or enters a '^' to exit, set XUXTADQUIT=1
+9 READ XUXTADPKG:DTIME
IF '$TEST!("^"[XUXTADPKG)
SET XUXTADQUIT=1
QUIT
+10 ;
+11 ; Test each character entered, do NOT allow lowercase characters
+12 ; and the first character should be alphabetic (or %).
+13 ;
+14 ;
FOR XUXTADPOS=1:1
if XUXTADPOS>$LENGTH(XUXTADPKG)!XUXTADQUIT
QUIT
Begin DoDot:1
+15 IF XUXTADPOS=1
IF "%ABCDEFGHIJKLMNOPQRSTUVWXYZ"'[$EXTRACT(XUXTADPKG)
Begin DoDot:2
+16 ; 1st character must be % or alphabetic
SET XUXTADQUIT=1
End DoDot:2
QUIT
+17 ; ASCII character representation
SET XUXTADASCII=$ASCII($EXTRACT(XUXTADPKG,XUXTADPOS,XUXTADPOS))
+18 ;
IF "0123456789"'[$EXTRACT(XUXTADPKG,XUXTADPOS,XUXTADPOS)
IF XUXTADASCII>96
IF XUXTADASCII<123
Begin DoDot:2
+19 ; Non-alphabetic or numeric char. found
SET XUXTADQUIT=1
End DoDot:2
End DoDot:1
+20 ;
+21 ;
IF XUXTADPKG["?"!(XUXTADPKG="")!($LENGTH(XUXTADPKG)<2)!($LENGTH(XUXTADPKG)>7)
Begin DoDot:1
+22 ; Namespace must be 2 to 7 characters
SET XUXTADQUIT=1
End DoDot:1
+23 ;
+24 IF XUXTADQUIT
DO ERRMSG1
DO ERRMSG2
GOTO ASKPKG1
+25 ; ASKPKG
QUIT
+26 ;
ASKYESNO(XUXTADPROMPT,XUXTADDEF) ; Extrinsic, prompt for YES, NO response
+1 ; Input:
+2 ; XUXTADPROMPT Optional - Text of prompt....input to DIR("A")
+3 ; XUXTADDEF Optional - Default response..input to DIR("B")
+4 ; will be "NO" if not passed on input
+5 ; Output: Y (for YES), N (for NO), or '^"
+6 ; Intended use:
+7 ; This API call was developed as a standardized wrapper call
+8 ; to the FM DIR utility when a YES or NO response is required.
+9 ; Note: The calling routine will be responsible for checking for a
+10 ; '^' response as shown in the example calls below.
+11 ;
+12 NEW %,DA,DIR,DIRUT,DTOUT,DUOUT,I,X,Y
+13 ; Default response to "NO" if not passed
SET XUXTADPROMPT=$GET(XUXTADPROMPT)
+14 SET XUXTADDEF=$GET(XUXTADDEF,"NO")
+15 ;
+16 ;S (DIR("?"),DIR("??"))="Enter 'Y' (for YES), 'N' (for NO), or '^' (to exit)"
+17 SET DIR("?")="Enter 'Y' (for YES), 'N' (for NO), or '^' (to exit)"
+18 SET DIR(0)="Y"
SET DIR("A")=XUXTADPROMPT
+19 IF XUXTADDEF]""
SET DIR("B")=XUXTADDEF
+20 ;
+21 DO FMDIR
+22 IF "^"[Y!(Y["^")
QUIT "^"
+23 IF Y=1
QUIT "Y"
+24 IF Y=0
QUIT "N"
+25 ; ASKYESNO
QUIT "N"
+26 ;
ERRMSG1 ; Package NAMESPACE requirements were NOT met.
+1 IF XUXTADPKG'["?"
WRITE " ??"
+2 WRITE !!?6,"Enter the first 2 to 7 characters of the Package NAMESPACE, or"
+3 WRITE !?6,"enter an '^' to exit."
+4 WRITE !!?6,"The first character must be an alphabetic or % character, followed by"
+5 WRITE !?6,"any alphanumeric combination, however, all alphabetic characters"
+6 WRITE !?6,"must be in uppercase with no lowercase characters allowed."
+7 ; ERRMSG1
QUIT
+8 ;
ERRMSG2 ; <CAPS LOCK> key if not on.
+1 DO CENTER("Make sure your <CAPS LOCK> key is on.",2,IOM,1)
+2 ; ERRMSG2
QUIT
+3 ;
GETKEYWD(XUXTADMINLEN,XUXTADMAXLEN) ; Prompt for KEYWORD
+1 ; Input:
+2 ; XUXTADMINLEN Required - Minimum length of KEYWORD specification
+3 ; XUXTADMAXLEN Required - Maximum length of KEYWORD specification
+4 ; XUXTADKEYWRD Required - externally defined, returned to caller.
+5 ; Output:
+6 ; XUXTADKEYWRD Keyword to be used later for screening output records
+7 ; (or user's response which could be null or "^")
+8 ; XUXTADQUIT 0 - Keyword successfully chosen
+9 ; 1 - User entered '^' or no keyword was chosen
+10 ;
+11 NEW XUXTADPOS
+12 WRITE !
GETKEY1 ; Return to this label upon receiving an incorrect response
+1 ;
+2 WRITE !,"Select a KEYWORD (from "_XUXTADMINLEN_" to "_XUXTADMAXLEN_" characters): "
+3 ; Do not quit when returning to the calling module
SET XUXTADQUIT=0
+4 ;
+5 READ XUXTADKEYWRD:DTIME
if '$TEST
SET XUXTADKEYWRD="^"
+6 ; No keyword found
IF XUXTADKEYWRD=""
SET XUXTADQUIT=1
QUIT
+7 ;User entered an '^'
IF XUXTADKEYWRD["^"
SET XUXTADQUIT=1
QUIT
+8 IF $LENGTH(XUXTADKEYWRD)<XUXTADMINLEN!($LENGTH(XUXTADKEYWRD)>XUXTADMAXLEN)
WRITE " ??"
GOTO GETKEY1
+9 FOR XUXTADPOS=1:1:$LENGTH(XUXTADKEYWRD)
Begin DoDot:1
+10 ; Verify that the Keyword is in uppercase format.
+11 ;
IF $ASCII($EXTRACT(XUXTADKEYWRD,XUXTADPOS,XUXTADPOS))>96
IF $ASCII($EXTRACT(XUXTADKEYWRD,XUXTADPOS,XUXTADPOS))<123
Begin DoDot:2
+12 NEW XUXTADMSG
+13 SET XUXTADMSG="Make sure <Caps Lock> key in on and re-enter your keyword"
+14 DO CENTER(XUXTADMSG,1,IOM,1)
+15 ; Keyword entered is not all uppercase chars.
SET XUXTADQUIT=1
End DoDot:2
End DoDot:1
IF XUXTADQUIT
GOTO GETKEY1
+16 ; GETKEYWD
QUIT
+17 ;
GETSORT(XUXTADRTN,XUXTADINPUT,XUXTADDEF) ; Get sorting criteria (generic subroutine call)
+1 ; Input:
+2 ; XUXTADRTN..... ; Required - Name of calling routine, typically $T(+0)
+3 ; XUXTADINPUT(n)=Sorting_Option - Required
+4 ; Where XUXTADINPUT represents the name of the input array, and n is a
+5 ; consecutive integer from 1 to the (n)umber of sorting options presented
+6 ; The input array name is passed by reference and any local array
+7 ; name can be used, although passing '.XUXTADSORT' is preferred
+8 ; which then allows the calling routine to utilize the user
+9 ; selected sorting option to be referenced as XUXTADSORT(XUXTADSORT).
+10 ; This also minimizes the number of variables that would have to
+11 ; be NEWed by the calling routine.
+12 ; XUXTADDEF Optional - Default integer response to prompt.
+13 ; Defaults to 1 if not passed
+14 ; If XUXTADDEF is passed and XUXTADINPUT(XUXTADDEF) exists, then XUXTADDEF
+15 ; becomes the default integer response allowing the
+16 ; developer to always override other previous default responses.
+17 ; Output:
+18 ; XUXTADSORT Integer representing user's sorting choice
+19 ; XUXTADQUIT Set to 1 if the user up-arrows out, otherwise 0.
+20 ;
+21 NEW XUXTADCNT,XUXTADPOS,XUXTADRESPONSE
+22 ;
+23 ; Set default response to input prompt in variable XUXTADDEF
+24 ;
+25 IF $GET(XUXTADDEF)>0
IF $DATA(XUXTADINPUT(XUXTADDEF))
SET XUXTADDEF=XUXTADDEF
+26 IF '$TEST
SET XUXTADDEF=1
+27 ; Do not quit when returning to the calling module
SET XUXTADQUIT=0
+28 ;
+29 WRITE !!,"Sort by"
+30 ;
FOR XUXTADCNT=1:1
if '$DATA(XUXTADINPUT(XUXTADCNT))
QUIT
Begin DoDot:1
+31 ; Horizontal print position
SET XUXTADPOS=$SELECT($LENGTH(XUXTADCNT)>9:$LENGTH(XUXTADCNT),1:2)
+32 WRITE !?XUXTADPOS,$JUSTIFY(XUXTADCNT,2),") ",XUXTADINPUT(XUXTADCNT)
End DoDot:1
+33 SET XUXTADCNT=XUXTADCNT-1
+34 ;
+35 SET XUXTADRESPONSE=$$ASKNUM(XUXTADCNT,XUXTADDEF)
IF XUXTADRESPONSE=""
SET XUXTADRESPONSE=XUXTADDEF
+36 ; User entered an '^'
IF XUXTADRESPONSE["^"
SET XUXTADQUIT=1
QUIT
+37 ;
+38 ;;02020-03-09 update
SET XUXTADINPUT=XUXTADRESPONSE
+39 SET XUXTADSORT=XUXTADRESPONSE
+40 ; GETSORT
QUIT
+41 ;
USRLIMIT(XUXTADRTN) ; Include (active users, inactive users, or both active and inactive users)
+1 ; Output:
+2 ; XUXTADULIMIT 1 for both active & inactive users
+3 ; 2 for active users
+4 ; 3 for inactive users
+5 ; XUXTADQUIT 0 - for successful selection at prompt
+6 ; 1 - if user enters an '^' to exit at prompt
+7 ; Input:
+8 ; XUXTADRTN Required - Name of calling routine; usually $T(+0)
+9 ;
+10 NEW XUXTADDEF
+11 ;
+12 SET XUXTADDEF=1
+13 ;
+14 WRITE !!,"Include"
+15 WRITE !?4,"1) Both active and inactive users"
+16 WRITE !?4,"2) Only active users"
+17 WRITE !?4,"3) Only inactive users"
+18 ;
+19 SET XUXTADULIMIT=$$ASKNUM(3,XUXTADDEF)
+20 ; User entered an '^'
IF XUXTADULIMIT="^"
SET XUXTADQUIT=1
QUIT
+21 ;
+22 ; Do not quit when returning to the calling module
SET XUXTADQUIT=0
+23 ; USRLIMIT
QUIT
+24 ;
+25 ;XUXTADASK1 ;ESL/JAC/cm - UTL Reusable prompting subroutines #1 ; 06/26/2020 09:30
