Return to DICF2.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

DICF2	;SEA/TOAD-VA FileMan: Finder, Part 3 (All Indexes) ;11/17/94  11:25 ;
	;;21.0;VA FileMan;;Dec 28, 1994
	;Per VHA Directive 10-93-142, this routine should not be modified.
	
CHKALL(DIFILE,DIEN,DIFLAGS,DIROOT,DIVALUE,DICOUNT,DISCREEN,DIFORCE,DIDENT,DILIST)	
	; FIND--central selection engine, check all indexes for matches
	; subroutine, DIFILE, DIFLAGS, & DIROOT passed by value
	N DIFNODE,DIFPIECE,DINDEX
	I DIFORCE S DINDEX=$P(DIFORCE(0),U),DIFNODE=0,DIFPIECE=1
	E  S DINDEX="B"
	N DIOUT S DIOUT=0
	I DIFLAGS["O" S DIFLAGS=DIFLAGS_"X"
	N DIALREDY,DISKIP
41	F  D  Q:DIFLAGS["q"!$G(DIERR)  I DIOUT D DECIDE(.DIFLAGS,.DINDEX,.DIFORCE,DICOUNT,.DIOUT,.DILIST) Q:DIOUT
	. S DIALREDY=0,DISKIP=0
	. D PREPIX(DIFILE,DIFLAGS,.DINDEX,.DIALREDY,.DISKIP,.DILIST)
	. I 'DIALREDY D
	. . I 'DISKIP D CHKONE^DICF3(DIFILE,.DIEN,.DIFLAGS,.DIROOT,DIVALUE,.DINDEX,.DICOUNT,.DISCREEN,.DIDENT,.DILIST)
	. . I DIFLAGS["q" S DIOUT=1 Q
	. . D CLEANIX(.DINDEX,.DILIST)
43	. . I DIFLAGS'["M" S DIOUT=1 Q
	. D NXTINDX(.DIROOT,.DINDEX,.DIFORCE,.DIFNODE,.DIFPIECE)
	. I DINDEX="" S DIOUT=1
	Q
	
PREPIX(DIFILE,DIFLAGS,DINDEX,DIALREDY,DISKIP,DILIST)	
	; CHKALL--lookup index type, add transform values to LVA
	; proc, DINDEX passed by ref
	K DINDEX(0,"GET")
	S DINDEX(0,"COUNT")=0
	S DINDEX(0,"TYPE")="F"
	N DIXFILE S DIXFILE=$O(^DD(DIFILE,0,"IX",DINDEX,0))
	I DIXFILE="" Q
	S DINDEX(0,"FILE")=DIXFILE
	N DIXFIELD S DIXFIELD=$O(^DD(DIFILE,0,"IX",DINDEX,DIXFILE,0))
50	I DIXFIELD="" Q
	S DINDEX(0,"FIELD")=DIXFIELD
	N DIVAL S DIVAL=@DILIST("LVA")@("V")
	S DIALREDY=0
	I DIALREDY,DIFLAGS["X"!$P(DIALREDY,U,2) Q
	S DIALREDY=0
	S DINDEX(0,"DEF")=$G(^DD(DIXFILE,DIXFIELD,0))
51	I DINDEX(0,"DEF")="" Q
	I DIFLAGS["g" D
	. S DINDEX(0,"GET")=$$FIELD^DICU1(DIXFILE,DIXFIELD,.DINDEX)
	N DISOUNDX S DISOUNDX=DIFLAGS'["Q" I DISOUNDX D
	. S DISOUNDX=$G(^DD(DIXFILE,0,"LOOK"))="SOUNDEX" Q:'DISOUNDX
	. S DISOUNDX=$$ISSNDX^DICF4(DIXFILE,DIXFIELD,DINDEX) Q:'DISOUNDX
	N DIXFLAG S DIXFLAG=$P(DINDEX(0,"DEF"),U,2)
	I $S(DIFLAGS["Q":1,DISOUNDX:0,DIXFLAG["F":1,1:DIXFLAG["N") Q
	S DINDEX(0,"FIRST")=10
	S DINDEX(0,"LAST")=9
	S DINDEX(0,"TYPE")=DIXFLAG
52	I DISOUNDX D  Q
	. D ADDVAL($$SOUNDEX^DICF4(@DILIST("LVA")@("V")),.DINDEX,.DILIST)
	I DIXFLAG["D" D PREPD(.DINDEX,.DILIST) Q
	I DIXFLAG["S" D PREPS^DICF6(DIFLAGS,.DINDEX,.DILIST) Q
	I DIXFLAG["P" D PREPP^DICF5(DIFLAGS,.DINDEX,"P",.DISKIP,.DILIST) Q
	I DIXFLAG["V" D PREPP^DICF5(DIFLAGS,.DINDEX,"VP",.DISKIP,.DILIST) Q
	Q
	
PREPD(DINDEX,DILIST)	
	; PREPIX--transform value for indexed date field
	; proc, DINDEX passed by ref
	N DIFLAGS S DIFLAGS=$P($P(DINDEX(0,"DEF"),"%DT=""",2),"""")
	N DIDATEFM
	D DT^DILF($TR(DIFLAGS,"ER")_"Ne",@DILIST("LVA")@("V"),.DIDATEFM)
	I DIDATEFM'>1 Q
	D ADDVAL(DIDATEFM,.DINDEX,.DILIST)
	Q
	
ADDVAL(DINEWVAL,DINDEX,DILIST)	
	; PREP*--add a new lookup value to the LVA
	; proc, DINDEX passed by ref
	S DINDEX(0,"COUNT")=DINDEX(0,"COUNT")+1
	S DINDEX(0,"LAST")=DINDEX(0,"LAST")+1
	S @DILIST("LVA")@("V",DINDEX(0,"LAST"))=DINEWVAL
	S @DILIST("LVA")@("V",DINDEX(0,"LAST"),1)=1
	S @DILIST("LVA")@("S",DINDEX(0,"LAST"))=@DILIST("LVA")@("S")
	Q
	
CLEANIX(DINDEX,DILIST)	
	; CHKALL--clear DINDEX & LVA of index data
	; proc, DINDEX passed by ref
	I DINDEX(0,"TYPE")["P"!(DINDEX(0,"TYPE")["V") D
	. K @DILIST("LVA")
	. S DILIST("LVA")=DILIST("SAVE")
	. K DILIST("SAVE")
	I 'DINDEX(0,"COUNT") K DINDEX(0) Q
	N DIKILL F DIKILL=DINDEX(0,"FIRST"):1:DINDEX(0,"LAST") D
	. K @DILIST("LVA")@("V",DIKILL),@DILIST("LVA")@("S",DIKILL)
	K DINDEX(0)
	Q
	
NXTINDX(DIROOT,DINDEX,DIFORCE,DIFNODE,DIFPIECE)	
	; CHKALL--return next index to try
	; subroutine, DIROOT passed by value
	I 'DIFORCE S DINDEX=$O(@DIROOT@(DINDEX)) Q
	S DIFPIECE=DIFPIECE+1
	S DINDEX=$P(DIFORCE(DIFNODE),U,DIFPIECE)
	Q
	
DECIDE(DIFLAGS,DINDEX,DIFORCE,DICOUNT,DIOUT,DILIST)	
	; CHKALL--if O needs to repeat: reset flags, starting index, & exit flag
	; subroutine, DICOUNT passed by value
	I DIFLAGS'["O" Q
	I DICOUNT Q
	S DIFLAGS=$TR(DIFLAGS,"OX")
	N DINODE,DISCRPRT
	S DINODE=0 F  S DINODE=$O(@DILIST("LVA")@("V",DINODE)) Q:DINODE=""  D
	. S DISCRPRT=$G(@DILIST("LVA")@("S",DINODE,2))
	. I DISCRPRT="" Q
D1	. S @DILIST("LVA")@("S",DINODE)=DISCRPRT
	I 'DIFORCE S DINDEX="B"
	E  S DINDEX=$P(DIFORCE(0),U)
	S DIOUT=0
	Q