| [613] | 1 | DICLIX0 ;SEA/TOAD,SF/TKW-FileMan: Continuation of DICLIX ;7/31/98 09:03
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999;
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | FINDMORE(DISUB,DIVAL,DIPART,DINDEX,DIMORE) ; Look across the numeric/string collation boundary
|
|---|
| 6 | ; Searching forwards
|
|---|
| 7 | N S,DIOUT S DIOUT=0
|
|---|
| 8 | I DINDEX(DISUB,"WAY")=1 D Q
|
|---|
| 9 | . I +$P(DIVAL,"E")=DIVAL,DIPART'=0 F D Q:DIOUT!(+$P(DIVAL,"E")'=DIVAL)
|
|---|
| 10 | . . I DIPART<DIVAL,((DIPART[".")!(DIPART<0)) S DIVAL=" " Q
|
|---|
| 11 | . . D NXT(.DIVAL,DIPART,1,DINDEX(DISUB,"ROOT"),.DIOUT) Q
|
|---|
| 12 | . Q:DIOUT
|
|---|
| 13 | . S DIMORE=0
|
|---|
| 14 | . S S=$O(@DINDEX(DISUB,"ROOT")@(DIPART_" "),-1)
|
|---|
| 15 | . S S=$O(@DINDEX(DISUB,"ROOT")@(S))
|
|---|
| 16 | . Q:S'=""&(DIVAL]]S) S DIVAL=S Q
|
|---|
| 17 | ; Searching backwards
|
|---|
| 18 | I +$P(DIVAL,"E")'=DIVAL S DIVAL=$O(@DINDEX(DISUB,"ROOT")@(" "),-1) Q:DIVAL=""
|
|---|
| 19 | I DIPART=0 S DIVAL=$S($D(@DINDEX(DISUB,"ROOT")@(0)):0,1:"") Q
|
|---|
| 20 | I DIPART>DIVAL,((DIPART[".")!(DIPART>0)) S DIVAL="" Q
|
|---|
| 21 | I DIPART<0,DIVAL>DIPART D
|
|---|
| 22 | . I $D(@DINDEX(DISUB,"ROOT")@(DIPART)) S DIVAL=DIPART Q
|
|---|
| 23 | . S DIVAL=$O(@DINDEX(DISUB,"ROOT")@(DIPART),-1) Q
|
|---|
| 24 | Q:$E(DIVAL,1,$L(DIPART))=DIPART!(DIVAL="")
|
|---|
| 25 | F D Q:DIOUT!(DIVAL="")
|
|---|
| 26 | . I DIPART>DIVAL,((DIPART[".")!(DIPART>0)) S DIVAL="" Q
|
|---|
| 27 | . D NXT(.DIVAL,DIPART,-1,DINDEX(DISUB,"ROOT"),.DIOUT) Q
|
|---|
| 28 | Q
|
|---|
| 29 | NXT(DIVAL,DIPART,DIWAY,DIROOT,DIOUT) ; Skip values we don't need to look at within numeric entries
|
|---|
| 30 | N DIPART2,DIVAL2,I,P,V
|
|---|
| 31 | S DIPART2=$P(DIPART,"."),DIVAL2=$P(DIVAL,".")
|
|---|
| 32 | S P=$S(DIPART<0:-DIPART2,1:DIPART2)
|
|---|
| 33 | S V=$S(DIVAL<0:$E(DIVAL2,2,($L(P)+1)),1:$E(DIVAL2,1,$L(P)))
|
|---|
| 34 | S I=$L(DIVAL2)
|
|---|
| 35 | I DIWAY=1&(DIPART>0)!(DIWAY=-1&(DIPART<0)) D
|
|---|
| 36 | . S:V>P I=I+1 Q
|
|---|
| 37 | E D
|
|---|
| 38 | . S DIPART2=DIPART2+$S(DIPART>0:1,1:-1)
|
|---|
| 39 | . I P>V,$L(DIPART2)=$L($P(DIPART,".")) S I=I-1
|
|---|
| 40 | S V="",I=I-$L(DIPART2)+1 S:I>1 $P(V,"0",I)=""
|
|---|
| 41 | S DIVAL=DIPART2_V
|
|---|
| 42 | I $E(DIVAL,1,$L(DIPART))=DIPART,$D(@DINDEX(DISUB,"ROOT")@(DIVAL)) S DIOUT=1 Q
|
|---|
| 43 | S DIVAL=$O(@DIROOT@(DIVAL),DIWAY)
|
|---|
| 44 | S:$E(DIVAL,1,$L(DIPART))=DIPART DIOUT=1
|
|---|
| 45 | Q
|
|---|
| 46 | ;
|
|---|
| 47 | ;
|
|---|
