| 1 | DIOS1 ;SFISC/GFT-BUILD SORT LOGIC ;04:33 PM  10 Nov 1999
 | 
|---|
| 2 |  ;;22.0;VA FileMan;**2**;Mar 30, 1999
 | 
|---|
| 3 |  ;Per VHA Directive 10-93-142, this routine should not be modified.
 | 
|---|
| 4 | L S X=$P(DPP(DL),U,2) S:X=0 X=.001
 | 
|---|
| 5 |  S W=+$P($P(DPP(DL),U,5),";L",2) I W D  G SL
 | 
|---|
| 6 |  . I $P(DPP(DL),U,5)[";TXT" S W=W+1
 | 
|---|
| 7 |  . S W=$S(W<DIOS:W,1:DIOS),DE(DL)=W,DE(DL,"SIC")=1 Q
 | 
|---|
| 8 |  I '$D(^DD(DX,+X,0)) D
 | 
|---|
| 9 |  . N I,Z,L S W=0
 | 
|---|
| 10 |  . S Z=$P(DPP(DL),U,4),L=$L(Z,Q)
 | 
|---|
| 11 |  . F I=2:1:L S X=+$P(Z,Q,I)
 | 
|---|
| 12 |  . Q
 | 
|---|
| 13 |  I '$D(^DD(DX,+X,0)) S W=30 G DJ:$P(DPP(DL),U,7)["D",LL
 | 
|---|
| 14 | X S DN=$P(^(0),U,2),W=+$P(DN,"J",2) G LL:W>8,DJ:W I $P(DN,"P",2) G X:$D(^DD(+$P(DN,"P",2),.01,0)),LL
 | 
|---|
| 15 | SHORTEN I DN["C"!(DN["K"),DN'["J" S W=30 G LL
 | 
|---|
| 16 |  I DN'["F" S DE=DE+5,W=13 S:$P(DPP(DL),U,5)[";TXT" W=14 G DJ
 | 
|---|
| 17 |  S W=+$P(^(0),"$L(X)>",2) S:'W W=30 S:W>DIOS W=DIOS
 | 
|---|
| 18 | LL I $P(DPP(DL),U,5)[";TXT" S W=W+1
 | 
|---|
| 19 |  S:W>8 DE(DL)=W,D5=D5+1
 | 
|---|
| 20 | SL S DE=DE+W-8
 | 
|---|
| 21 | DJ I $O(DPP(DL,-1)) D  I X=.001 S DE=DE+W
 | 
|---|
| 22 |  . N I,J S I=0
 | 
|---|
| 23 |  . F J=0:0 S J=$O(DPP(DL,J)) Q:'J  S I=I+1
 | 
|---|
| 24 |  . S DE=(I*4)+DE Q
 | 
|---|
| 25 |  Q
 | 
|---|