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 Apr 09, 2024@20:46:16 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
