Annotation of freem_fileman/DICF6.m, revision 1.1

1.1     ! snw         1: DICF6  ;SEA/TOAD-VA FileMan: Finder, Part 7 (Sets of Codes) ;10/18/94  12:02 ;
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        
        !             5: PREPS(DIFLAGS,DINDEX,DILIST)   
        !             6:        ; transform value for indexed set of codes field
        !             7:        ; proc, DINDEX passed by ref
        !             8:        N DICODE,DIMEAN,DIPAIR,DISKIP,DITRY,DIVAL
        !             9:        N DISET S DISET=$P(DINDEX(0,"DEF"),U,3)
        !            10: CODES  
        !            11:        N DIP F DIP=1:1:$L(DISET,";")-1 D
        !            12:        . S DIPAIR=$P(DISET,";",DIP)
        !            13:        . S DIVAL=0 F  D  Q:DIVAL=""!(DIVAL>8)
        !            14:        . . S DIVAL=$O(@DILIST("LVA")@("V",DIVAL)) Q:DIVAL=""!(DIVAL>8)
        !            15:        . . I "^1^2^5^6^"'[(U_DIVAL_U) Q
        !            16:        . . S DIMEAN=$P(DIPAIR,":",2)
        !            17:        . . S DITRY=@DILIST("LVA")@("V",DIVAL)
        !            18:        . . I $P(DIMEAN,DITRY)'="" Q
        !            19:        . . I DIFLAGS["X",DIMEAN'=DITRY Q
        !            20:        . . S DICODE=$P(DIPAIR,":")
        !            21:        . . I DICODE=DITRY Q
        !            22: MATCH  . . 
        !            23:        . . D ADDVAL^DICF2(DICODE,.DINDEX,.DILIST)
        !            24:        Q
        !            25:        
        !            26: ERR(DIERN,DIFILE,DIIENS,DIFIELD,DI1,DI2,DI3)   
        !            27:        ; error logging procedure
        !            28:        N DIPE
        !            29:        N DI F DI="FILE","IENS","FIELD",1:1:3 S DIPE(DI)=$G(@("DI"_DI))
        !            30:        D BLD^DIALOG(DIERN,.DIPE,.DIPE)
        !            31:        Q
        !            32:        
        !            33:        

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>