File:  [Coherent Logic Development] / freem_fileman / USER / DIOS1.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:21 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

    1: DIOS1	;SFISC/GFT-BUILD SORT LOGIC ;10/12/94  11:08
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    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)) S W=+$P($P(DPP(DL),U,4),"""",2) I '$D(^DD(DX,W,0)) S W=30 G DJ:$P(DPP(DL),U,7)["D",LL
    9: 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
   10: 	I DN["C",DN'["J" S W=30 G LL
   11: 	I DN'["F" S DE=DE+5,W=13 S:$P(DPP(DL),U,5)[";TXT" W=14 G DJ
   12: 	S W=+$P(^(0),"$L(X)>",2) S:'W W=30 S:W>DIOS W=DIOS
   13: LL	I $P(DPP(DL),U,5)[";TXT" S W=W+1
   14: 	S:W>8 DE(DL)=W,D5=D5+1
   15: SL	S DE=DE+W-8
   16: DJ	I $O(DPP(DL,-1)) D  I X=.001 S DE=DE+W
   17: 	. N I,J S I=0
   18: 	. F J=0:0 S J=$O(DPP(DL,J)) Q:'J  S I=I+1
   19: 	. S DE=(I*4)+DE Q
   20: 	Q

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>