Return to DICF2.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DICF2.m, revision 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