DICF1	;SEA/TOAD-VA FileMan: Finder, Part 2 (Transform) ;11/17/94  12:21 ;
	;;21.0;VA FileMan;;Dec 28, 1994
	;Per VHA Directive 10-93-142, this routine should not be modified.
	
XFORM(DIFLAGS,DIVALUE,DISCREEN,DILVA,DILIST)	
	; FIND--produce array of values and screens by transforming input
	; subroutine, DIVALUE, DINDEX, & DISCREEN passed by reference
BASIC	
	N DISNAME S DISNAME="DILVA(""S"")"
	N DIVNAME S DIVNAME="DILVA(""V"")"
	S @DIVNAME=DIVALUE
	S @DISNAME=DISCREEN
SETLONG	
	N DILONG S DILONG=$S(DIFLAGS["Q":0,1:$L(DIVALUE)>29&(DIFLAGS'["U")*4)
	I DILONG N DISNAMES S DISNAMES=DISNAME,DISNAME=$NA(@DISNAME@(0))
	N DISNAMEX S DISNAMEX=$NA(@DILIST("LVA")@("S"))
	I DILONG S DISNAMEX=$NA(@DISNAMEX@(0))
	I DILONG N DIVNAMES S DIVNAMES=DIVNAME,DIVNAME=$NA(@DIVNAME@(0))
	N DIVNAMEX S DIVNAMEX=$NA(@DILIST("LVA")@("V"))
	I DILONG S DIVNAMEX=$NA(@DIVNAMEX@(0))
	S @DIVNAME@(1+DILONG)=DIVALUE
	S @DISNAME@(1+DILONG)=DISCREEN
	I DIFLAGS["Q" Q
LOWER	
	I DIVALUE?.E1L.E N DILOWER,DIUPPER D
	. S DILOWER="abcdefghijklmnopqrstuvwxyz"
	. S DIUPPER="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
	. N DITEMP S DITEMP=$TR(DIVALUE,DILOWER,DIUPPER)
	. S @DIVNAME@(2+DILONG)=DITEMP
	. S @DISNAME@(2+DILONG)=DISCREEN
	
COMMA	N DIREF I DIVALUE[",",DIFLAGS'["X" D
	. S DIFLAGS=DIFLAGS_"g"
	. N DISTEMP S DISTEMP=""
	. N DIPART1 S DIPART1=" I %?.E1P1"""
	. N DIPART2 S DIPART2=""".E!(D'=""B""&(%?1"""
	. N DIPART3 S DIPART3=""".E))"
	. N DIOUT S DIOUT=0
21	. N DIPIECE,DIVPIECE F DIPIECE=2:1 D  I DIOUT Q
	. . S DIVPIECE=$P(DIVALUE,",",DIPIECE)
	. . I DIVPIECE["""" Q
	. . I $E(DIVPIECE)=" " S DIVPIECE=$E(DIVPIECE,2,$L(DIVPIECE))
	. . I DIVPIECE="" S DIOUT=1 Q
	. . I $L(DIVPIECE)*2+$L(DISTEMP)+33+14+34>255 S DIOUT=1 Q
	. . S DISTEMP=DISTEMP_DIPART1_DIVPIECE_DIPART2_DIVPIECE_DIPART3
22	. I DISTEMP="" Q
	. S DISTEMP="S %=DIFIELD"_DISTEMP
	. S DIREF=$NA(@DISNAMEX@(1+DILONG))
	. N DISOLD I @DIREF="" S DISOLD=""
	. E  S DISOLD=" X "_DIREF
	. S @DIVNAME@(3+DILONG)=$P(DIVALUE,",")
	. S @DISNAME@(3+DILONG)=DISTEMP_DISOLD
23	. I DIVALUE'?.E1L.E Q
	. S DIREF=$NA(@DISNAMEX@(2+DILONG))
	. I @DIREF="" S DISOLD=""
	. E  S DISOLD=" X "_DIREF
	. S @DIVNAME@(4+DILONG)=$TR($P(DIVALUE,","),DILOWER,DIUPPER)
	. S @DISNAME@(4+DILONG)=$TR(DISTEMP,DILOWER,DIUPPER)_DISOLD
	
LONG	I 'DILONG Q
	I DIFLAGS'["g" S DIFLAGS=DIFLAGS_"g"
	N DINODE,DISLONG,DISPART,DISXACT
	F DINODE=5:1:8 I $D(@DIVNAME@(DINODE))#2 D
	. S @DIVNAMES@(DINODE)=$E(@DIVNAME@(DINODE),1,30)
	. S DIREF=$NA(@DISNAMEX@(DINODE))
	. I @DIREF="" S DISLONG=""
	. E  S DISLONG=" X "_DIREF
	. S DIREF=$NA(@DIVNAMEX@(DINODE))
	. S DISPART="I $P(DIFIELD,"_DIREF_")="""""_DISLONG
	. S DISXACT="I $P(DIFIELD,U)="_DIREF_DISLONG
L10	. I DIFLAGS["X" S @DISNAMES@(DINODE)=DISXACT Q
	. I DIFLAGS'["O" S @DISNAMES@(DINODE)=DISPART Q
	. S @DISNAMES@(DINODE)=DISXACT
	. S @DISNAMES@(DINODE,2)=DISPART
	Q
	
SPECIAL(DIFILE,DIEN,DIFLAGS,DIROOT,DIVALUE,DINDEX,DICOUNT,DIFAIL,DISCREEN,DIDENT,DIOUT,DILIST)	
	; FIND--check the pick value for special formats
	; proc, DICOUNT, DIDENT, & DIFAIL by reference
	S DIOUT=0
	I U[DIVALUE S DIFAIL=1,DIOUT=1 Q
	I DIVALUE'?.ANP S DIFAIL=1,DIOUT=1 D ERR^DICF6(204,"","","",DIVALUE) Q
11	I DIVALUE=" " D  S DIOUT=1 Q
	. N DINODE S DINODE=$G(^DISV(DUZ,$E(DIROOT("Q"),1,28)))
	. N DINODEL S DINODEL=$L(DINODE,",")
	. I $P(DINODE,",",1,DINODEL-1)'=$E(DIROOT("Q"),29,9999) S DIFAIL=1 Q
	. N DIENTRY S DIENTRY=$P(DINODE,",",DINODEL)
	. I 'DIENTRY S DIFAIL=1 Q
	. S DIEN=DIENTRY_DIEN
	. D ENTRY
	. I DICOUNT'>DICOUNT(0) S DIFAIL=1 Q
12	I DIVALUE?1"`"1.N D  S DIOUT=1 Q
	. N DIENTRY S DIENTRY=$E(DIVALUE,2,$L(DIVALUE))
	. S DIEN=DIENTRY_DIEN
	. D ENTRY
	. S $P(DIEN,",")=""
	. I DICOUNT'>DICOUNT(0) S DIFAIL=1
13	I $S(DIVALUE?1.N:1,DIVALUE'?.NP:0,1:+DIVALUE=DIVALUE) D  Q:DICOUNT>DICOUNT(0)
	. N DI001 S DI001=$D(^DD(DIFILE,.001))
	. N DI01FLAG S DI01FLAG=$P($G(^DD(DIFILE,.01,0)),U,2)
	. I $D(@DIROOT@(DIVALUE)) D  I DICOUNT>DICOUNT(0) Q
	. . I DIFLAGS'["A",'DI001,DI01FLAG["N"!($O(@DIROOT@("A["))'="") Q
	. . S DIEN=DIVALUE_DIEN
	. . D ENTRY
	. . S $P(DIEN,",")=""
	. . I DIFLAGS["q" S DIOUT=1
	Q
	
ENTRY	D ENTRY^DICF3(DIFILE,.DIEN,.DIFLAGS,.DIROOT,.DIVALUE,DINDEX,.DICOUNT,.DISCREEN,.DIDENT,.DILIST)
	Q