source: WorldVistAEHR/trunk/r/CAPACITY_MANAGEMENT_TOOLS-KMPD-KMPL/KMPDUT4B.m@ 1639

Last change on this file since 1639 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.0 KB
RevLine 
[613]1KMPDUT4B ;OAK/RAK; Multi-Lookup Array Selection cont. ;2/17/04 10:48
2 ;;2.0;CAPACITY MANAGEMENT TOOLS;;Mar 22, 2002
3 ;
4 ;--------------------------------------------------------------------
5 ; sub-routines to select entries - called from ^KMPDUT4
6 ;--------------------------------------------------------------------
7ALL ;all entries selected
8 Q:'$D(ARRAY)!('$D(DIC)) S MAX=+$G(MAX),SORT=+$G(SORT)
9 K @ARRAY I DIC S DIC=$G(^DIC(DIC,0,"GL"))
10 I MAX,($P($G(@(DIC_"0)")),U,4)>MAX) S @ARRAY@(0)="*" Q
11 N ASKI W " selecting 'All' entries"
12 F ASKI=0:0 S ASKI=$O(@(DIC_ASKI_")")) Q:'ASKI D SET(ASKI)
13 Q
14DISPLAY ;display entries that have been selected
15 Q:'$D(DIC) S SORT=+$G(SORT)
16 I '$D(@ARRAY) W !!,"...no entries have been selected...",! Q
17 I @ARRAY@(0)="*" W !!,"...'All' entries have been selected...",! Q
18 D HDR^KMPDUTL4("Selected Entries from "_$P($G(@(DIC_"0)")),U)_" file")
19 N ASKI,ASKOUT S ASKI="",ASKOUT=1 W !!
20 F S ASKI=$O(@ARRAY@(ASKI)) Q:ASKI=""!(ASKOUT'=1) I ASKI'=0 D
21 .I $Y>(IOSL-4) D Q:ASKOUT'=1
22 ..D FTR^KMPDUTL4("",.ASKOUT) Q:ASKOUT'=1
23 ..D HDR^KMPDUTL4("Selected Entries from "_$P($G(@(DIC_"0)")),U)_" file")
24 ..W !!
25 .W !?7,$S(SORT=1:ASKI,1:@ARRAY@(ASKI))
26 W !
27 Q
28WILDCARD(X) ;entries with wildcard selected
29 ;--------------------------------------------------------------------
30 ; allow wildcard selections
31 ; examples: A*
32 ; ABC*
33 ; SMITH*
34 ;--------------------------------------------------------------------
35 Q:$G(X)']""
36 N ASKI,COUNT,NARRAY,OUT,STR,STR1 S (COUNT,OUT)=0
37 S MAX=+$G(MAX),SORT=+$G(SORT) S:$G(D)']"" D="B"
38 S STR=$E(X,1,($F(X,"*")-2)) Q:STR']""
39 S STR1=STR,NARRAY=DIC_""""_D_""""_")"
40 ;--------------------------------------------------------------------
41 ; if exact match on STR1
42 ;--------------------------------------------------------------------
43 I $D(@NARRAY@(STR1)) S ASKI=0 D Q
44 .I STR?.N S NARRAY=DIC_""""_D_""""_","_STR_")"
45 .E S NARRAY=DIC_""""_D_""""_","_""""_STR_""""_")"
46 .F S ASKI=$O(@NARRAY@(ASKI)) Q:'ASKI D Q:OUT
47 ..D SET(ASKI) I MAX,(+$G(@ARRAY@(0))=MAX) S OUT=1
48 ;--------------------------------------------------------------------
49 ; if not an exact match
50 ;--------------------------------------------------------------------
51 F S STR1=$O(@NARRAY@(STR1)) Q:$E(STR1,1,$L(STR))'=STR D Q:OUT
52 .F ASKI=0:0 S ASKI=$O(@NARRAY@(STR1,ASKI)) Q:'ASKI D Q:OUT
53 ..D SET(ASKI) I MAX,(+$G(@ARRAY@(0))=MAX) S OUT=1
54 Q
55SET(IFN) ;set selected data into array
56 ;--------------------------------------------------------------------
57 ; IFN - internal file number of entry
58 ;--------------------------------------------------------------------
59 N X,Y S IFN=+$G(IFN),SORT=+$G(SORT) Q:'IFN
60 Q:'$D(DIC)!('$D(ARRAY))
61 Q:'$D(@(DIC_IFN_",0)"))!($P($G(^(0)),U)']"")
62 S X="`"_ASKI,DIC(0)="Z" D ^DIC Q:Y'>0
63 I SORT=1 S @ARRAY@(Y(0,0))=+Y
64 E S @ARRAY@(+Y)=Y(0,0)
65 S @ARRAY@(0)=$G(@ARRAY@(0))+1 W:$X>73 !?7 W "."
66 Q
67 ; for future use - if unable to use `IFN in call to ^DIC
68 I SORT=1 S @ARRAY@($P($G(@(DIC_ASKI_",0)")),U))=ASKI
69 E S @ARRAY@(ASKI)=$P($G(@(DIC_ASKI_",0)")),U)
Note: See TracBrowser for help on using the repository browser.