Return to DIO1.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIO1.m, revision 1.1.1.1

1.1       snw         1: DIO1   ;SFISC/GFT,TKW-BUILD P-ARRAY WHICH CREATES SORTED DATA ;9/1/94  12:41
                      2:        ;;21.0;VA FileMan;;Dec 28, 1994
                      3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
                      4:        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:DPR=""  Q:DPR=""  S X=0 D A
                      5:        .Q:'$D(DIBTPGM)  I $G(P(DX))]"" S %=P(DX),DISETQ=1 D SETU
                      6:        .Q
                      7:        K W S W="",Z=" S:$T ^UTILITY($J,0" F X=1:1:DPP D  I W]"" D OVZ
                      8:        .N % S %=$S($P(DPP(X),U,4)["'":1,1:J(X)) I ($L(Z)+$L(%))'>180 S Z=Z_C_% Q
                      9:        .I %=J(X),J(X)'="DISX("_X_")" S W=W_" S DISX("_X_")="_J(X),%="DISX("_X_")"
                     10:        .S Z=Z_C_% Q
                     11:        F V=1:1:DPP I V=DPP&(W="")!(DPP(V)-DP) S F=C,Y=DP,%=1,X=0 D U D:$L(W)+$L(Z)+$L(F)+$L(DX(DPQ))+$S(V(DPQ):38,1:0)>237  S W=W_Z_F_")="""""
                     12:        .I '$D(DIBTPGM) S DIOVFL(V)=$E(W,2,999),W=" X DIOVFL("_V_")" Q
                     13:        .S %=W,(%(1),%(2))="OV",W=" D OV"_DICOV D SETU^DIOS
                     14:        .Q
                     15:        F X=-1:0 S X=$O(DX(X)),DX=X Q:X=""  D
                     16:        .N A,B S A=""
                     17:        .I $D(DIBTPGM) S B=+$O(^TMP("DIBTC",$J,X,0)),A=$G(^(B))
                     18:        .S:$E(DX(X),1)=" " DX(X)=$E(DX(X),2,999)
                     19:        .S:A="" A=DX(X)
                     20:        .S:X=DPQ A=A_W_$P(",DJ=DJ+1",U,$D(DIS)>9)
                     21:        .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"
                     22:        .S DX(X)=A Q:'$D(DIBTPGM)
                     23:        .S:B ^TMP("DIBTC",$J,X,B)=A S DX(X)="D "_$P(A," ")
                     24:        .Q
                     25:        S DX(0)=DX(DP),DX=0,DPQ=0 K:DP DX(DP)
                     26:        ;
                     27: 2      K D,%,I D 2^DIO I $G(DIERR) G IXK^DIO
                     28:        K DIOVFL,P,V,Y,D0,D1,D2,D3 K:'$D(DIB) DIS S:$D(DIBTPGM) DIBTPGM=""
                     29:        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_$E(",DDDDDDDDDDD",1,DPP+3-X)_0
                     30:        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:"")
                     31:        K DX S DX=^UTILITY($J,"DX"),DJ=^("F"),%=$O(^("DX",-1)) S:%="" %=-1 F %=%:0 S DX(%)=^(%),%=$O(^(%)) I %="" G GO^DIO
                     32:        ;
                     33: U      S:$D(D(Y)) X=X_D(Y) S %=%+1,Y=$P(Z(V),C,%),D=Y="",F=$S(F'=C:F_",D"_X,D:",D"_X,1:",D"_X_C_V) Q:D  S X=V(Y) G U
                     34:        ;
                     35: A      S X=$O(Y(DJ,DX,DPR,X)) Q:X=""  D B G A
                     36:        ;
                     37: B      S DL=Y(DJ,DX,DPR,X),W="DISX("_DL_")",DIO="=""""",D2=""
                     38:        I 'X,DL>$G(DPP(0)) S:'$D(DPP(DL,"CM")) W="D"_V(DX),DIO="<0"
                     39:        I X S Z=$P($P(^DD(DX,+X,0),U,4),";",2) S:$E(Z)="E" DIO="?."" """
                     40:        S Z="" S:$C(63,122)=$P($G(DPP(DL,"F")),U) Z=1 S:$P($G(DPP(DL,"T")),U)="@" Z=Z+2
                     41:        S F=$S($P(DPP(DL),U,4)["-":"999999999-",$P(DPP(DL),U,10)=2:"+",1:"")_$S($D(DE(DL)):"$E("_W_",1,"_DE(DL)_")",1:W)
                     42:        I Z S F="$S("_W_"'"_DIO_":"_F_",1:""  EMPTY"")" I Z>2 S F=""" """
                     43:        S J(DL)=F
                     44:        S P(DX)=$S($D(P(DX)):P(DX)_" ",1:"")
                     45:        S Y=$S($E(W,1,5)="DISX(":"S "_W_"="""" ",1:"")_DPP(DL,"GET")
                     46:        S DLN=$G(DPP(DL,"QCON")) I DL=DJK&$D(DPP(DL,"IX"))!(DLN="") S DLN="I "_W_"]"""""
                     47:        I $D(DIBTPGM) D  G BX
                     48:        .N % I $L(P(DX))+$L(Y)+$L(DLN)>237 S %=$E(P(DX),1,($L(P(DX))-1)) D SETU S P(DX)="I  "
                     49:        .S P(DX)=P(DX)_Y_" "_DLN Q
                     50:        I DPP>2!($L(P(DX))+$L(Y)>125) F Z=1:1 I '$D(P(DX,Z)) S P(DX,Z)=Y,P(DX)=P(DX)_"X P("_DX_C_Z_")"_$P(" I ",C,Y[" I ")_" "_DLN Q
                     51:        E  S P(DX)=P(DX)_Y_" "_DLN
                     52: BX     S Y=DX Q
                     53:        ;
                     54: OVZ    I '$D(DIBTPGM) S DIOVFL("SX"_X)=$E(W,2,999),Z=" X DIOVFL(""SX"_X_""") "_Z,W="" Q
                     55:        N % I $D(DIBTPGM) S %=W,(%(1),%(2))="OV",Z=" D OV"_DICOV_" "_Z D SETU^DIOS
                     56:        S W="" Q
                     57:        ;
                     58: SETU   Q:%=""  N A
                     59:        S A=$G(DICP(DX)) I A S A="P"_A
                     60:        S ^TMP("DIBTC",$J,"P",DICNT)=A_" "_%
                     61:        I $D(DISETQ) S ^((DICNT+.001))=" Q" K DISETQ
                     62:        K DICP(DX) S DICNT=DICNT+1
                     63:        Q