Return to DICF2.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DICF2	;SEA/TOAD-VA FileMan: Finder, Part 3 (All Indexes) ;11/17/94  11:25 ;
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	
    5: CHKALL(DIFILE,DIEN,DIFLAGS,DIROOT,DIVALUE,DICOUNT,DISCREEN,DIFORCE,DIDENT,DILIST)	
    6: 	; FIND--central selection engine, check all indexes for matches
    7: 	; subroutine, DIFILE, DIFLAGS, & DIROOT passed by value
    8: 	N DIFNODE,DIFPIECE,DINDEX
    9: 	I DIFORCE S DINDEX=$P(DIFORCE(0),U),DIFNODE=0,DIFPIECE=1
   10: 	E  S DINDEX="B"
   11: 	N DIOUT S DIOUT=0
   12: 	I DIFLAGS["O" S DIFLAGS=DIFLAGS_"X"
   13: 	N DIALREDY,DISKIP
   14: 41	F  D  Q:DIFLAGS["q"!$G(DIERR)  I DIOUT D DECIDE(.DIFLAGS,.DINDEX,.DIFORCE,DICOUNT,.DIOUT,.DILIST) Q:DIOUT
   15: 	. S DIALREDY=0,DISKIP=0
   16: 	. D PREPIX(DIFILE,DIFLAGS,.DINDEX,.DIALREDY,.DISKIP,.DILIST)
   17: 	. I 'DIALREDY D
   18: 	. . I 'DISKIP D CHKONE^DICF3(DIFILE,.DIEN,.DIFLAGS,.DIROOT,DIVALUE,.DINDEX,.DICOUNT,.DISCREEN,.DIDENT,.DILIST)
   19: 	. . I DIFLAGS["q" S DIOUT=1 Q
   20: 	. . D CLEANIX(.DINDEX,.DILIST)
   21: 43	. . I DIFLAGS'["M" S DIOUT=1 Q
   22: 	. D NXTINDX(.DIROOT,.DINDEX,.DIFORCE,.DIFNODE,.DIFPIECE)
   23: 	. I DINDEX="" S DIOUT=1
   24: 	Q
   25: 	
   26: PREPIX(DIFILE,DIFLAGS,DINDEX,DIALREDY,DISKIP,DILIST)	
   27: 	; CHKALL--lookup index type, add transform values to LVA
   28: 	; proc, DINDEX passed by ref
   29: 	K DINDEX(0,"GET")
   30: 	S DINDEX(0,"COUNT")=0
   31: 	S DINDEX(0,"TYPE")="F"
   32: 	N DIXFILE S DIXFILE=$O(^DD(DIFILE,0,"IX",DINDEX,0))
   33: 	I DIXFILE="" Q
   34: 	S DINDEX(0,"FILE")=DIXFILE
   35: 	N DIXFIELD S DIXFIELD=$O(^DD(DIFILE,0,"IX",DINDEX,DIXFILE,0))
   36: 50	I DIXFIELD="" Q
   37: 	S DINDEX(0,"FIELD")=DIXFIELD
   38: 	N DIVAL S DIVAL=@DILIST("LVA")@("V")
   39: 	S DIALREDY=0
   40: 	I DIALREDY,DIFLAGS["X"!$P(DIALREDY,U,2) Q
   41: 	S DIALREDY=0
   42: 	S DINDEX(0,"DEF")=$G(^DD(DIXFILE,DIXFIELD,0))
   43: 51	I DINDEX(0,"DEF")="" Q
   44: 	I DIFLAGS["g" D
   45: 	. S DINDEX(0,"GET")=$$FIELD^DICU1(DIXFILE,DIXFIELD,.DINDEX)
   46: 	N DISOUNDX S DISOUNDX=DIFLAGS'["Q" I DISOUNDX D
   47: 	. S DISOUNDX=$G(^DD(DIXFILE,0,"LOOK"))="SOUNDEX" Q:'DISOUNDX
   48: 	. S DISOUNDX=$$ISSNDX^DICF4(DIXFILE,DIXFIELD,DINDEX) Q:'DISOUNDX
   49: 	N DIXFLAG S DIXFLAG=$P(DINDEX(0,"DEF"),U,2)
   50: 	I $S(DIFLAGS["Q":1,DISOUNDX:0,DIXFLAG["F":1,1:DIXFLAG["N") Q
   51: 	S DINDEX(0,"FIRST")=10
   52: 	S DINDEX(0,"LAST")=9
   53: 	S DINDEX(0,"TYPE")=DIXFLAG
   54: 52	I DISOUNDX D  Q
   55: 	. D ADDVAL($$SOUNDEX^DICF4(@DILIST("LVA")@("V")),.DINDEX,.DILIST)
   56: 	I DIXFLAG["D" D PREPD(.DINDEX,.DILIST) Q
   57: 	I DIXFLAG["S" D PREPS^DICF6(DIFLAGS,.DINDEX,.DILIST) Q
   58: 	I DIXFLAG["P" D PREPP^DICF5(DIFLAGS,.DINDEX,"P",.DISKIP,.DILIST) Q
   59: 	I DIXFLAG["V" D PREPP^DICF5(DIFLAGS,.DINDEX,"VP",.DISKIP,.DILIST) Q
   60: 	Q
   61: 	
   62: PREPD(DINDEX,DILIST)	
   63: 	; PREPIX--transform value for indexed date field
   64: 	; proc, DINDEX passed by ref
   65: 	N DIFLAGS S DIFLAGS=$P($P(DINDEX(0,"DEF"),"%DT=""",2),"""")
   66: 	N DIDATEFM
   67: 	D DT^DILF($TR(DIFLAGS,"ER")_"Ne",@DILIST("LVA")@("V"),.DIDATEFM)
   68: 	I DIDATEFM'>1 Q
   69: 	D ADDVAL(DIDATEFM,.DINDEX,.DILIST)
   70: 	Q
   71: 	
   72: ADDVAL(DINEWVAL,DINDEX,DILIST)	
   73: 	; PREP*--add a new lookup value to the LVA
   74: 	; proc, DINDEX passed by ref
   75: 	S DINDEX(0,"COUNT")=DINDEX(0,"COUNT")+1
   76: 	S DINDEX(0,"LAST")=DINDEX(0,"LAST")+1
   77: 	S @DILIST("LVA")@("V",DINDEX(0,"LAST"))=DINEWVAL
   78: 	S @DILIST("LVA")@("V",DINDEX(0,"LAST"),1)=1
   79: 	S @DILIST("LVA")@("S",DINDEX(0,"LAST"))=@DILIST("LVA")@("S")
   80: 	Q
   81: 	
   82: CLEANIX(DINDEX,DILIST)	
   83: 	; CHKALL--clear DINDEX & LVA of index data
   84: 	; proc, DINDEX passed by ref
   85: 	I DINDEX(0,"TYPE")["P"!(DINDEX(0,"TYPE")["V") D
   86: 	. K @DILIST("LVA")
   87: 	. S DILIST("LVA")=DILIST("SAVE")
   88: 	. K DILIST("SAVE")
   89: 	I 'DINDEX(0,"COUNT") K DINDEX(0) Q
   90: 	N DIKILL F DIKILL=DINDEX(0,"FIRST"):1:DINDEX(0,"LAST") D
   91: 	. K @DILIST("LVA")@("V",DIKILL),@DILIST("LVA")@("S",DIKILL)
   92: 	K DINDEX(0)
   93: 	Q
   94: 	
   95: NXTINDX(DIROOT,DINDEX,DIFORCE,DIFNODE,DIFPIECE)	
   96: 	; CHKALL--return next index to try
   97: 	; subroutine, DIROOT passed by value
   98: 	I 'DIFORCE S DINDEX=$O(@DIROOT@(DINDEX)) Q
   99: 	S DIFPIECE=DIFPIECE+1
  100: 	S DINDEX=$P(DIFORCE(DIFNODE),U,DIFPIECE)
  101: 	Q
  102: 	
  103: DECIDE(DIFLAGS,DINDEX,DIFORCE,DICOUNT,DIOUT,DILIST)	
  104: 	; CHKALL--if O needs to repeat: reset flags, starting index, & exit flag
  105: 	; subroutine, DICOUNT passed by value
  106: 	I DIFLAGS'["O" Q
  107: 	I DICOUNT Q
  108: 	S DIFLAGS=$TR(DIFLAGS,"OX")
  109: 	N DINODE,DISCRPRT
  110: 	S DINODE=0 F  S DINODE=$O(@DILIST("LVA")@("V",DINODE)) Q:DINODE=""  D
  111: 	. S DISCRPRT=$G(@DILIST("LVA")@("S",DINODE,2))
  112: 	. I DISCRPRT="" Q
  113: D1	. S @DILIST("LVA")@("S",DINODE)=DISCRPRT
  114: 	I 'DIFORCE S DINDEX="B"
  115: 	E  S DINDEX=$P(DIFORCE(0),U)
  116: 	S DIOUT=0
  117: 	Q