source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DICLIX0.m@ 808

Last change on this file since 808 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1DICLIX0 ;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 ;
5FINDMORE(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
29NXT(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 ;
Note: See TracBrowser for help on using the repository browser.