Return to DIO1.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIO1.m, revision 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