70 lines
3.0 KiB
Mathematica
70 lines
3.0 KiB
Mathematica
KMPDUT4B ;OAK/RAK; Multi-Lookup Array Selection cont. ;2/17/04 10:48
|
|
;;2.0;CAPACITY MANAGEMENT TOOLS;;Mar 22, 2002
|
|
;
|
|
;--------------------------------------------------------------------
|
|
; sub-routines to select entries - called from ^KMPDUT4
|
|
;--------------------------------------------------------------------
|
|
ALL ;all entries selected
|
|
Q:'$D(ARRAY)!('$D(DIC)) S MAX=+$G(MAX),SORT=+$G(SORT)
|
|
K @ARRAY I DIC S DIC=$G(^DIC(DIC,0,"GL"))
|
|
I MAX,($P($G(@(DIC_"0)")),U,4)>MAX) S @ARRAY@(0)="*" Q
|
|
N ASKI W " selecting 'All' entries"
|
|
F ASKI=0:0 S ASKI=$O(@(DIC_ASKI_")")) Q:'ASKI D SET(ASKI)
|
|
Q
|
|
DISPLAY ;display entries that have been selected
|
|
Q:'$D(DIC) S SORT=+$G(SORT)
|
|
I '$D(@ARRAY) W !!,"...no entries have been selected...",! Q
|
|
I @ARRAY@(0)="*" W !!,"...'All' entries have been selected...",! Q
|
|
D HDR^KMPDUTL4("Selected Entries from "_$P($G(@(DIC_"0)")),U)_" file")
|
|
N ASKI,ASKOUT S ASKI="",ASKOUT=1 W !!
|
|
F S ASKI=$O(@ARRAY@(ASKI)) Q:ASKI=""!(ASKOUT'=1) I ASKI'=0 D
|
|
.I $Y>(IOSL-4) D Q:ASKOUT'=1
|
|
..D FTR^KMPDUTL4("",.ASKOUT) Q:ASKOUT'=1
|
|
..D HDR^KMPDUTL4("Selected Entries from "_$P($G(@(DIC_"0)")),U)_" file")
|
|
..W !!
|
|
.W !?7,$S(SORT=1:ASKI,1:@ARRAY@(ASKI))
|
|
W !
|
|
Q
|
|
WILDCARD(X) ;entries with wildcard selected
|
|
;--------------------------------------------------------------------
|
|
; allow wildcard selections
|
|
; examples: A*
|
|
; ABC*
|
|
; SMITH*
|
|
;--------------------------------------------------------------------
|
|
Q:$G(X)']""
|
|
N ASKI,COUNT,NARRAY,OUT,STR,STR1 S (COUNT,OUT)=0
|
|
S MAX=+$G(MAX),SORT=+$G(SORT) S:$G(D)']"" D="B"
|
|
S STR=$E(X,1,($F(X,"*")-2)) Q:STR']""
|
|
S STR1=STR,NARRAY=DIC_""""_D_""""_")"
|
|
;--------------------------------------------------------------------
|
|
; if exact match on STR1
|
|
;--------------------------------------------------------------------
|
|
I $D(@NARRAY@(STR1)) S ASKI=0 D Q
|
|
.I STR?.N S NARRAY=DIC_""""_D_""""_","_STR_")"
|
|
.E S NARRAY=DIC_""""_D_""""_","_""""_STR_""""_")"
|
|
.F S ASKI=$O(@NARRAY@(ASKI)) Q:'ASKI D Q:OUT
|
|
..D SET(ASKI) I MAX,(+$G(@ARRAY@(0))=MAX) S OUT=1
|
|
;--------------------------------------------------------------------
|
|
; if not an exact match
|
|
;--------------------------------------------------------------------
|
|
F S STR1=$O(@NARRAY@(STR1)) Q:$E(STR1,1,$L(STR))'=STR D Q:OUT
|
|
.F ASKI=0:0 S ASKI=$O(@NARRAY@(STR1,ASKI)) Q:'ASKI D Q:OUT
|
|
..D SET(ASKI) I MAX,(+$G(@ARRAY@(0))=MAX) S OUT=1
|
|
Q
|
|
SET(IFN) ;set selected data into array
|
|
;--------------------------------------------------------------------
|
|
; IFN - internal file number of entry
|
|
;--------------------------------------------------------------------
|
|
N X,Y S IFN=+$G(IFN),SORT=+$G(SORT) Q:'IFN
|
|
Q:'$D(DIC)!('$D(ARRAY))
|
|
Q:'$D(@(DIC_IFN_",0)"))!($P($G(^(0)),U)']"")
|
|
S X="`"_ASKI,DIC(0)="Z" D ^DIC Q:Y'>0
|
|
I SORT=1 S @ARRAY@(Y(0,0))=+Y
|
|
E S @ARRAY@(+Y)=Y(0,0)
|
|
S @ARRAY@(0)=$G(@ARRAY@(0))+1 W:$X>73 !?7 W "."
|
|
Q
|
|
; for future use - if unable to use `IFN in call to ^DIC
|
|
I SORT=1 S @ARRAY@($P($G(@(DIC_ASKI_",0)")),U))=ASKI
|
|
E S @ARRAY@(ASKI)=$P($G(@(DIC_ASKI_",0)")),U)
|