Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: KMPDUT4B

KMPDUT4B.m

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