- DIOS1 ;SFISC/GFT-BUILD SORT LOGIC ;04:33 PM 10 Nov 1999 [ 04/02/2003 8:25 AM ]
- ;;22.0;VA FileMan;**1001**;APR 1, 2003
- ;;22.0;VA FileMan;**2**;Mar 30, 1999
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- L S X=$P(DPP(DL),U,2) S:X=0 X=.001
- S W=+$P($P(DPP(DL),U,5),";L",2) I W D G SL
- . I $P(DPP(DL),U,5)[";TXT" S W=W+1
- . S W=$S(W<DIOS:W,1:DIOS),DE(DL)=W,DE(DL,"SIC")=1 Q
- I '$D(^DD(DX,+X,0)) D
- . N I,Z,L S W=0
- . S Z=$P(DPP(DL),U,4),L=$L(Z,Q)
- . F I=2:1:L S X=+$P(Z,Q,I)
- . Q
- I '$D(^DD(DX,+X,0)) S W=30 G DJ:$P(DPP(DL),U,7)["D",LL
- 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
- SHORTEN I DN["C"!(DN["K"),DN'["J" S W=30 G LL
- I DN'["F" S DE=DE+5,W=13 S:$P(DPP(DL),U,5)[";TXT" W=14 G DJ
- S W=+$P(^(0),"$L(X)>",2) S:'W W=30 S:W>DIOS W=DIOS
- LL I $P(DPP(DL),U,5)[";TXT" S W=W+1
- S:W>8 DE(DL)=W,D5=D5+1
- SL S DE=DE+W-8
- DJ I $O(DPP(DL,-1)) D I X=.001 S DE=DE+W
- . N I,J S I=0
- . F J=0:0 S J=$O(DPP(DL,J)) Q:'J S I=I+1
- . S DE=(I*4)+DE Q
- Q
- DIOS1 ;SFISC/GFT-BUILD SORT LOGIC ;04:33 PM 10 Nov 1999 [ 04/02/2003 8:25 AM ]
- +1 ;;22.0;VA FileMan;**1001**;APR 1, 2003
- +2 ;;22.0;VA FileMan;**2**;Mar 30, 1999
- +3 ;Per VHA Directive 10-93-142, this routine should not be modified.
- L SET X=$PIECE(DPP(DL),U,2)
- IF X=0
- SET X=.001
- +1 SET W=+$PIECE($PIECE(DPP(DL),U,5),";L",2)
- IF W
- Begin DoDot:1
- +2 IF $PIECE(DPP(DL),U,5)[";TXT"
- SET W=W+1
- +3 SET W=$SELECT(W<DIOS:W,1:DIOS)
- SET DE(DL)=W
- SET DE(DL,"SIC")=1
- QUIT
- End DoDot:1
- GOTO SL
- +4 IF '$DATA(^DD(DX,+X,0))
- Begin DoDot:1
- +5 NEW I,Z,L
- SET W=0
- +6 SET Z=$PIECE(DPP(DL),U,4)
- SET L=$LENGTH(Z,Q)
- +7 FOR I=2:1:L
- SET X=+$PIECE(Z,Q,I)
- +8 QUIT
- End DoDot:1
- +9 IF '$DATA(^DD(DX,+X,0))
- SET W=30
- IF $PIECE(DPP(DL),U,7)["D"
- GOTO DJ
- GOTO LL
- X SET DN=$PIECE(^(0),U,2)
- SET W=+$PIECE(DN,"J",2)
- IF W>8
- GOTO LL
- IF W
- GOTO DJ
- IF $PIECE(DN,"P",2)
- IF $DATA(^DD(+$PIECE(DN,"P",2),.01,0))
- GOTO X
- GOTO LL
- SHORTEN IF DN["C"!(DN["K")
- IF DN'["J"
- SET W=30
- GOTO LL
- +1 IF DN'["F"
- SET DE=DE+5
- SET W=13
- IF $PIECE(DPP(DL),U,5)[";TXT"
- SET W=14
- GOTO DJ
- +2 SET W=+$PIECE(^(0),"$L(X)>",2)
- IF 'W
- SET W=30
- IF W>DIOS
- SET W=DIOS
- LL IF $PIECE(DPP(DL),U,5)[";TXT"
- SET W=W+1
- +1 IF W>8
- SET DE(DL)=W
- SET D5=D5+1
- SL SET DE=DE+W-8
- DJ IF $ORDER(DPP(DL,-1))
- Begin DoDot:1
- +1 NEW I,J
- SET I=0
- +2 FOR J=0:0
- SET J=$ORDER(DPP(DL,J))
- IF 'J
- QUIT
- SET I=I+1
- +3 SET DE=(I*4)+DE
- QUIT
- End DoDot:1
- IF X=.001
- SET DE=DE+W
- +4 QUIT
