DIOS1 ;SFISC/GFT-BUILD SORT LOGIC ;04:33 PM 10 Nov 1999
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIOS1 1178 printed Apr 09, 2024@21:52:01 Page 2
DIOS1 ;SFISC/GFT-BUILD SORT LOGIC ;04:33 PM 10 Nov 1999
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
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
