| 1 | DICF5 ;SEA/TOAD,SF/TKW-VA FileMan: Finder, (Other lookup value transform) ;5/26/99 10:05
|
|---|
| 2 | ;;22.0;VA FileMan;**4**;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | PREPS(DIFLAGS,DISUB,DINDEX,DINODE,DIVALUE) ;
|
|---|
| 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(DINODE,U,3)
|
|---|
| 10 | CODES ;
|
|---|
| 11 | N DIP F DIP=1:1:$L(DISET,";")-1 D
|
|---|
| 12 | . S DIPAIR=$P(DISET,";",DIP)
|
|---|
| 13 | . F DIVAL=1,2 S DITRY=$G(DIVALUE(DISUB,DIVAL)) D:DITRY]""
|
|---|
| 14 | . . I DIVAL=2,DIFLAGS["l" Q
|
|---|
| 15 | . . S DIMEAN=$P(DIPAIR,":",2)
|
|---|
| 16 | . . I $P(DIMEAN,DITRY)'="" Q
|
|---|
| 17 | . . I DIFLAGS["X",DIMEAN'=DITRY Q
|
|---|
| 18 | . . S DICODE=$P(DIPAIR,":")
|
|---|
| 19 | . . I $G(DINDEX(DISUB,"TRANCODE"))="" D Q
|
|---|
| 20 | . . . S:DICODE'=DITRY DIVALUE(DISUB,(4+DIVAL))=DICODE Q
|
|---|
| 21 | . . N X S X=DICODE X DINDEX(DISUB,"TRANCODE") Q:X=""
|
|---|
| 22 | . . S DIVALUE(DISUB,7)=X Q
|
|---|
| 23 | . Q
|
|---|
| 24 | Q
|
|---|
| 25 | ;
|
|---|
| 26 | POINT(DISUB,DIFLAGS,DIFILE,DINDEX,DIVALUE,DISCREEN) ; Add transform values for dates and sets at end of pointer chain
|
|---|
| 27 | ; save off the primary file info, follow the ptr chain to the end
|
|---|
| 28 | N DIVPTR,DIF,DITYPE S DIVPTR=$S(DINDEX(DISUB,"TYPE")="V":1,1:0)
|
|---|
| 29 | M DIF=DIFILE N DIFILE M DIFILE=DIF K DIF
|
|---|
| 30 | N DIFIL,DIFLD S DIFIL=+DINDEX(DISUB,"FILE"),DIFLD=+DINDEX(DISUB,"FIELD")
|
|---|
| 31 | N DINODE S DINODE=$G(^DD(DIFIL,DIFLD,0)) Q:DINODE=""
|
|---|
| 32 | D FOLLOW^DICL3(.DIFILE,"",DINODE,1,0,"",DIFLD,DIFIL,DIVPTR,DISUB,.DISCREEN)
|
|---|
| 33 | N DIEND F DIEND=0:0 S DIEND=$O(DIFILE("STACKEND",DIEND)) Q:'DIEND D
|
|---|
| 34 | . S DIFIL=$P(DIFILE("STACKEND",DIEND),U,2)
|
|---|
| 35 | . S DINODE=$G(^DD(DIFIL,.01,0)),DITYPE=$P(DINODE,U,2)
|
|---|
| 36 | . I DITYPE["F"!(DITYPE["N") D Q
|
|---|
| 37 | . . Q:$G(DINDEX(DISUB,"TRANCODE"))=""
|
|---|
| 38 | . . N X S X=DIVALUE(DISUB) X DINDEX(DISUB,"TRANCODE") Q:X=""
|
|---|
| 39 | . . S DIVALUE(DISUB,5)=X Q
|
|---|
| 40 | . I $P(DINODE,U,2)["D" D PREPD(DISUB,.DINDEX,DINODE,.DIVALUE) Q
|
|---|
| 41 | . I $P(DINODE,U,2)["S" D PREPS(DIFLAGS,DISUB,.DINDEX,DINODE,.DIVALUE)
|
|---|
| 42 | . Q
|
|---|
| 43 | Q
|
|---|
| 44 | ;
|
|---|
| 45 | PREPD(DISUB,DINDEX,DINODE,DIVALUE) ;
|
|---|
| 46 | ; PREPIX--transform value for indexed date field
|
|---|
| 47 | N D S D=$G(DIVALUE(DISUB)) Q:D=""
|
|---|
| 48 | N DIFLAGS S DIFLAGS=$P($P(DINODE,"%DT=""",2),"""")
|
|---|
| 49 | N DIDATEFM
|
|---|
| 50 | D DT^DILF($TR(DIFLAGS,"ER")_"Ne",D,.DIDATEFM)
|
|---|
| 51 | I DIDATEFM'>1 Q
|
|---|
| 52 | I $G(DINDEX(DISUB,"TRANCODE"))="" S DIVALUE(DISUB,5)=DIDATEFM Q
|
|---|
| 53 | N X S X=DIDATEFM X DINDEX(DISUB,"TRANCODE") Q:X=""
|
|---|
| 54 | S DIVALUE(DISUB,6)=X
|
|---|
| 55 | Q
|
|---|
| 56 | ;
|
|---|
| 57 | SOUNDEX(DIVALUE) ; func, convert value to soundex value
|
|---|
| 58 | N DICODE S DICODE="01230129022455012623019202"
|
|---|
| 59 | N DISOUND S DISOUND=$C($A(DIVALUE)-(DIVALUE?1L.E*32))
|
|---|
| 60 | N DIPREV S DIPREV=$E(DICODE,$A(DIVALUE)-64)
|
|---|
| 61 | N DICHAR,DIPOS
|
|---|
| 62 | F DIPOS=2:1 S DICHAR=$E(DIVALUE,DIPOS) Q:","[DICHAR D Q:$L(DISOUND)=4
|
|---|
| 63 | . Q:DICHAR'?1A
|
|---|
| 64 | . N DITRANS S DITRANS=$E(DICODE,$A(DICHAR)-$S(DICHAR?1U:64,1:96))
|
|---|
| 65 | . Q:DITRANS=DIPREV Q:DITRANS=9
|
|---|
| 66 | . S DIPREV=DITRANS
|
|---|
| 67 | . I DITRANS'=0 S DISOUND=DISOUND_DITRANS
|
|---|
| 68 | Q $E(DISOUND_"000",1,4)
|
|---|
| 69 | ;
|
|---|
