56 lines
3.1 KiB
Mathematica
56 lines
3.1 KiB
Mathematica
DIO1 ;SFISC/GFT,TKW-BUILD P-ARRAY (OR LINES IN COMPILED SORT) WHICH CREATES SORTED DATA ;20MAR2005
|
|
;;22.0;VA FileMan;**2,97,113,144**;Mar 30, 1999;Build 5
|
|
;Per VHA Directive 2004-038, this routine should not be modified.
|
|
;
|
|
F DJ=0:1:7 F DX=-1:0 S DX=$O(Y(DJ,DX)) Q:DX="" F DPR=-1:0 S DPR=$O(Y(DJ,DX,DPR)) D Q:DPR=""
|
|
.I DPR="" D:$D(DIBTPGM) SETU("Q") Q
|
|
.S X=0
|
|
A .F S X=$O(Y(DJ,DX,DPR,X)) Q:X="" D
|
|
B ..N DL,DIF,W,DICOND,Z,%,BACKWARD
|
|
..S DL=Y(DJ,DX,DPR,X),W="DISX("_DL_")",DICOND="=""""",D2="" I $P(DPP(DL),U,4)["-" S BACKWARD="-"
|
|
..I 'X,DL>$G(DPP(0)) S:'$D(DPP(DL,"CM")) W=$G(BACKWARD)_"D"_V(DX),DICOND="<0"
|
|
..I X S Z=$P($P(^DD(DX,+X,0),U,4),";",2) S:$E(Z)="E" DICOND="?."" """
|
|
..S Z="" S:$C(63,122)=$P($G(DPP(DL,"F")),U) Z=1 S:$P($G(DPP(DL,"T")),U)="@" Z=Z+2 ;From NULL:Z=1 To NULL:Z=2 Both:Z=3
|
|
..S DIF=$S($D(BACKWARD):BACKWARD,$P(DPP(DL),U,10)=2:"+",1:"")_$S($D(DE(DL)):"$E("_W_",1,"_DE(DL)_")",1:W) ;DE array was set in ^DIOS
|
|
..I Z S DIF="$S("_W_"'"_DICOND_":"_DIF_",1:"" EMPTY"")"
|
|
..S J(DL)=W
|
|
..I Z=3 S J(DL)=""" """ K DIF ;if just looking for NULLs
|
|
..I $P(DPP(DL),U,4)["'" S J(DL)=1 K DIF ;if Sort Value doesn't matter
|
|
..S P(DX)=$S($D(P(DX)):P(DX)_" ",1:"")
|
|
..S Y=$S(W?1"DISX(".E:"S "_W_"="""" ",1:"")_DPP(DL,"GET")
|
|
..S DICOND=$G(DPP(DL,"QCON")) I DL=DJK&$D(DPP(DL,"IX"))!(DICOND="") S DICOND="I "_W_"]"""""
|
|
SORTVAL ..I $D(DIF),DIF'=W S DICOND=DICOND_" S DISX("_DL_")="_DIF
|
|
..S Y=Y_" ",DIF="" D S Y=DICOND,DIF="I " D
|
|
...I $D(DIBTPGM) D SETU(Y) D:DIF]"" SETU("Q:'$T") Q
|
|
...I DPP>2!($L(P(DX))+$L(Y)>125) S Z=$O(P(DX,""),-1)+1,P(DX,Z)=Y,P(DX)=P(DX)_"X P("_DX_","_Z_") "_DIF Q
|
|
...S P(DX)=P(DX)_Y
|
|
BX ..S Y=DX Q
|
|
UTILITY K W S W="",Z=" S:$T ^UTILITY($J,0" F X=1:1:DPP S Z=Z_","_$G(J(X),1)
|
|
SUB F V=1:1:DPP I V=DPP&(W="")!(DPP(V)-DP) S F=",",Y=DP,%=1,X=0 D S W=W_Z_F_")="""""
|
|
U .S:$D(D(Y)) X=X_D(Y) S %=%+1,Y=$P(Z(V),",",%),D=Y="",F=$S(F'=",":F_",D"_X,D:",D"_X,1:",D"_X_","_V) I 'D S X=V(Y) G U
|
|
.I $L(W)+$L(Z)+$L(F)+$L(DX(DPQ))+$S(V(DPQ):38,1:0)>237 D
|
|
..I '$D(DIBTPGM) S DIOVFL(V)=$E(W,2,999),W=" X DIOVFL("_V_")" Q
|
|
..S %=W,(%(1),%(2))="OV",W=" D OV"_DICOV D SETU^DIOS
|
|
DX F X=-1:0 S X=$O(DX(X)),DX=X Q:X="" D
|
|
.N A,B S A=""
|
|
.I $D(DIBTPGM) S B=+$O(^TMP("DIBTC",$J,X,0)),A=$G(^(B))
|
|
.S:A="" A=DX(X)
|
|
.S:X=DPQ A=A_W_$P(",DJ=DJ+1",U,$D(DIS)>9)
|
|
.I V(X) S F="",%(0)=DX,%=DCC S:$D(DXIX(DX)) F=DXIX(DX) D:F="" GREF^DIOU(.V,.%,.F) S A=A_" "_"S D"_V(X)_"=$O("_F_")) Q:D"_V(X)_"'>0"
|
|
.S DX(X)=A Q:'$D(DIBTPGM)
|
|
.S:B ^TMP("DIBTC",$J,X,B)=A S DX(X)="D "_$P(A," ")
|
|
0 S DX(0)=DX(DP),DX=0,DPQ=0 K:DP DX(DP)
|
|
;
|
|
2 K D,%,I D 2^DIO D I $G(DIERR) G IXK^DIO
|
|
.I $G(DIERR),$D(^UTILITY($J,0))>0 D CLEAN^DILF
|
|
K DIOVFL,P,V,Y,D0,D1,D2,D3 K:'$D(DIB) DIS S:$D(DIBTPGM) DIBTPGM=""
|
|
DIOO1 S V="I $D(^UTILITY($J,0" K DPP(0,"F"),DPP(0,"T") F X=1:1:DPP K DPP(X,"F"),DPP(X,"T") S V=V_",DIOO"_(DPP-X+1)
|
|
F X=-1:0 S X=$O(DX(X)) Q:X="" I $D(DX(X,U)) S DSC(X)=V_DX(X,U)_$S($D(DSC(X)):" "_DSC(X),1:"")
|
|
K DX S DX=^UTILITY($J,"DX"),DJ=^("F"),%=$O(^("DX",-1)) S:%="" %=-1 F %=%:0 S DX(%)=^(%),%=$O(^(%)) I %="" G GO^DIO
|
|
;
|
|
SETU(%) Q:%="" N A
|
|
S A=$G(DICP(DX)) I A S A="P"_A
|
|
S ^TMP("DIBTC",$J,"P",DICNT)=A_" "_%
|
|
K DICP(DX) S DICNT=DICNT+1
|
|
Q
|