DIOS1.m

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