Return to DICF6.m CVS log

Up to [Coherent Logic Development] / freem_fileman

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