- KMPDUT4 ;OAK/RAK; Multi-Lookup ;2/17/04 10:46
- ;;3.0;KMPD;;Jan 22, 2009;Build 42
- ;
- SELECT(ARRAY,SORT,MAX,OPTION) ;select one or more entries
- ;--------------------------------------------------------------------
- ; this routine lets user select one or more entries from a file
- ;
- ; ARRAY - the array the data is to be stored in
- ; this may be a local or global array
- ; ARRAY(0) - will contain the number of entries selected
- ;
- ; SORT - determines how the array is set
- ; 0 - internal file number
- ; 1 - first piece of zero node
- ;
- ; if zero then ARRAY(internal_number)=external_format
- ; if one then ARRAY(external_format)=internal_number
- ;
- ; internal_number - the internal file number selected
- ; external_format - the first piece of the zero node or
- ; Y(0,0)
- ;
- ; MAX - if defined this represents the maximum number of entries
- ; to stuff into array
- ; - if '*' is selected and the number of file entries
- ; exceeds this number the array will be killed and
- ; ARRAY(0) will be equal to "*"
- ; - if while selecting one entry at a time the number
- ; of entries is equal to MAX the routine will quit with
- ; the entries stored as usual and ARRAY(0)=MAX
- ; this is to prevent partition store errors with local
- ; arrays or setting a global equal all the patients in
- ; the patient file
- ;
- ; OPTION - selected options
- ; S - suppress asterisk (*) ;'(* for All)' prompt
- ; W - allow selected wildcards
- ; example: A* - will select all entries beginning
- ; with the letter 'A'
- ; SMITH* - will select all entries beginning
- ; with 'SMITH'
- ;
- ; DIC - this variable must be defined in the normal fileman
- ; format
- ; DIC("A") - this variable should be defined
- ; the string " (* for All)" will be concatenated to the end
- ; DIC("S") - may be defined if necessary and will be honored
- ; DIC(0) - *** IMPORTANT ***
- ; this will be set to DIC(0)="EQZ" for the purposes of
- ; this routine
- ;
- ; example: S DIC=4,DIC("A")="Select Institution: "
- ; D SELECT^KMPDUT4("^TMP($J,")
- ; D SELECT^KMPDUT4("LOCAL",1,20)
- ; D SELECT^KMPDUT4("LOCAL($J)",1,0,"W")
- ;
- ; *** It is the programmers responsibility kill ***
- ; *** 'ARRAY' when finished with the data ***
- ;--------------------------------------------------------------------
- I $$CHECK^KMPDUT4A D FTR^KMPDUTL4("Press <RET> to continue") Q
- S OPTION=$$UP^XLFSTR($G(OPTION))
- S SORT=+$G(SORT),MAX=+$G(MAX) S:SORT'=1 SORT=0
- I MAX=1,(OPTION'["S") S OPTION=OPTION_"S"
- S DIC(0)="EMQZ",DTIME=$S($G(DTIME):DTIME,1:600)
- I $G(DIC("A"))'["(* for All): ",(OPTION'["S") D
- .S DIC("A")=$G(DIC("A"))_" (* for All): "
- K @ARRAY F D Q:X=""!(X="^")
- .I MAX,(+$G(@ARRAY@(0))=MAX) S X="" Q
- .W !
- .I '$D(@ARRAY) W DIC("A")
- .E W $J(" ",$L(DIC("A"))-12),"...another: "
- .R X:DTIME Q:X=""!(X="^")
- .I X="*",(MAX=1) D Q
- ..W *7,!!?7,"...you are allowed only one selection...",!
- .I X="*",(OPTION["S") D Q
- ..W *7,!!?7,"...'*' not allowed...",!
- .I X="*" D ALL^KMPDUT4B S X="" Q
- .I $E(X)="-" D MINUS^KMPDUT4C(X) Q
- .;-------------------------------------------------------------------
- .; wildcard selection
- .;-------------------------------------------------------------------
- .I $E(X,2,999)["*",(OPTION["W") D WILDCARD^KMPDUT4B(X) Q
- .I $E(X,1,2)="?D"!($E(X,1,2)="?d") D DISPLAY^KMPDUT4B Q
- .I X="?",(MAX'=1) D HELP^KMPDUT4C
- .D ^DIC I Y>0,('$D(@ARRAY@($S(SORT=1:Y(0,0),1:+Y)))) D
- ..I SORT=1 S @ARRAY@(Y(0,0))=+Y
- ..E S @ARRAY@(+Y)=Y(0,0)
- ..S @ARRAY@(0)=$G(@ARRAY@(0))+1
- EXIT ;
- K X,Y
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HKMPDUT4 4027 printed Jan 18, 2025@02:42:26 Page 2
- KMPDUT4 ;OAK/RAK; Multi-Lookup ;2/17/04 10:46
- +1 ;;3.0;KMPD;;Jan 22, 2009;Build 42
- +2 ;
- SELECT(ARRAY,SORT,MAX,OPTION) ;select one or more entries
- +1 ;--------------------------------------------------------------------
- +2 ; this routine lets user select one or more entries from a file
- +3 ;
- +4 ; ARRAY - the array the data is to be stored in
- +5 ; this may be a local or global array
- +6 ; ARRAY(0) - will contain the number of entries selected
- +7 ;
- +8 ; SORT - determines how the array is set
- +9 ; 0 - internal file number
- +10 ; 1 - first piece of zero node
- +11 ;
- +12 ; if zero then ARRAY(internal_number)=external_format
- +13 ; if one then ARRAY(external_format)=internal_number
- +14 ;
- +15 ; internal_number - the internal file number selected
- +16 ; external_format - the first piece of the zero node or
- +17 ; Y(0,0)
- +18 ;
- +19 ; MAX - if defined this represents the maximum number of entries
- +20 ; to stuff into array
- +21 ; - if '*' is selected and the number of file entries
- +22 ; exceeds this number the array will be killed and
- +23 ; ARRAY(0) will be equal to "*"
- +24 ; - if while selecting one entry at a time the number
- +25 ; of entries is equal to MAX the routine will quit with
- +26 ; the entries stored as usual and ARRAY(0)=MAX
- +27 ; this is to prevent partition store errors with local
- +28 ; arrays or setting a global equal all the patients in
- +29 ; the patient file
- +30 ;
- +31 ; OPTION - selected options
- +32 ; S - suppress asterisk (*) ;'(* for All)' prompt
- +33 ; W - allow selected wildcards
- +34 ; example: A* - will select all entries beginning
- +35 ; with the letter 'A'
- +36 ; SMITH* - will select all entries beginning
- +37 ; with 'SMITH'
- +38 ;
- +39 ; DIC - this variable must be defined in the normal fileman
- +40 ; format
- +41 ; DIC("A") - this variable should be defined
- +42 ; the string " (* for All)" will be concatenated to the end
- +43 ; DIC("S") - may be defined if necessary and will be honored
- +44 ; DIC(0) - *** IMPORTANT ***
- +45 ; this will be set to DIC(0)="EQZ" for the purposes of
- +46 ; this routine
- +47 ;
- +48 ; example: S DIC=4,DIC("A")="Select Institution: "
- +49 ; D SELECT^KMPDUT4("^TMP($J,")
- +50 ; D SELECT^KMPDUT4("LOCAL",1,20)
- +51 ; D SELECT^KMPDUT4("LOCAL($J)",1,0,"W")
- +52 ;
- +53 ; *** It is the programmers responsibility kill ***
- +54 ; *** 'ARRAY' when finished with the data ***
- +55 ;--------------------------------------------------------------------
- +56 IF $$CHECK^KMPDUT4A
- DO FTR^KMPDUTL4("Press <RET> to continue")
- QUIT
- +57 SET OPTION=$$UP^XLFSTR($GET(OPTION))
- +58 SET SORT=+$GET(SORT)
- SET MAX=+$GET(MAX)
- if SORT'=1
- SET SORT=0
- +59 IF MAX=1
- IF (OPTION'["S")
- SET OPTION=OPTION_"S"
- +60 SET DIC(0)="EMQZ"
- SET DTIME=$SELECT($GET(DTIME):DTIME,1:600)
- +61 IF $GET(DIC("A"))'["(* for All): "
- IF (OPTION'["S")
- Begin DoDot:1
- +62 SET DIC("A")=$GET(DIC("A"))_" (* for All): "
- End DoDot:1
- +63 KILL @ARRAY
- FOR
- Begin DoDot:1
- +64 IF MAX
- IF (+$GET(@ARRAY@(0))=MAX)
- SET X=""
- QUIT
- +65 WRITE !
- +66 IF '$DATA(@ARRAY)
- WRITE DIC("A")
- +67 IF '$TEST
- WRITE $JUSTIFY(" ",$LENGTH(DIC("A"))-12),"...another: "
- +68 READ X:DTIME
- if X=""!(X="^")
- QUIT
- +69 IF X="*"
- IF (MAX=1)
- Begin DoDot:2
- +70 WRITE *7,!!?7,"...you are allowed only one selection...",!
- End DoDot:2
- QUIT
- +71 IF X="*"
- IF (OPTION["S")
- Begin DoDot:2
- +72 WRITE *7,!!?7,"...'*' not allowed...",!
- End DoDot:2
- QUIT
- +73 IF X="*"
- DO ALL^KMPDUT4B
- SET X=""
- QUIT
- +74 IF $EXTRACT(X)="-"
- DO MINUS^KMPDUT4C(X)
- QUIT
- +75 ;-------------------------------------------------------------------
- +76 ; wildcard selection
- +77 ;-------------------------------------------------------------------
- +78 IF $EXTRACT(X,2,999)["*"
- IF (OPTION["W")
- DO WILDCARD^KMPDUT4B(X)
- QUIT
- +79 IF $EXTRACT(X,1,2)="?D"!($EXTRACT(X,1,2)="?d")
- DO DISPLAY^KMPDUT4B
- QUIT
- +80 IF X="?"
- IF (MAX'=1)
- DO HELP^KMPDUT4C
- +81 DO ^DIC
- IF Y>0
- IF ('$DATA(@ARRAY@($SELECT(SORT=1:Y(0,0),1:+Y))))
- Begin DoDot:2
- +82 IF SORT=1
- SET @ARRAY@(Y(0,0))=+Y
- +83 IF '$TEST
- SET @ARRAY@(+Y)=Y(0,0)
- +84 SET @ARRAY@(0)=$GET(@ARRAY@(0))+1
- End DoDot:2
- End DoDot:1
- if X=""!(X="^")
- QUIT
- EXIT ;
- +1 KILL X,Y
- +2 QUIT