Return to DICF2.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DICF2.m, revision 1.1.1.1

1.1       snw         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