Return to DIOS.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIOS.m, revision 1.1

1.1     ! snw         1: DIOS   ;SFISC/GFT,TKW-BUILD SORT LOGIC ;9/2/94  11:19
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        D INIT S ^UTILITY($J,"DX")=DX,^("F")="^UTILITY($J,0,"_DCC_U_(DPP+1)
        !             5:        F X=-1:0 S X=$O(DX(X)) Q:X=""  S ^UTILITY($J,"DX",X)=DX(X)
        !             6: C      K DX F DL=1:1:DPP S DX=+DPP(DL),V(DX,2)=DL,X=DP,(DPQ,DJ)=0,Z(DL)="" D A S X=999-$P($G(DPP(DL,"SER")),U,2),Y(DPQ,DX,X,$E($P(DPP(DL),U,2,3),1,30))=DL
        !             7:        F DL=1:1:DPP K %,DIOS S Z=Z(DL),%=0 D U I D5,DE>0,$D(DE(DL))=1 S DE(DL)=DE(DL)-(DE\D5) S:DE(DL)<4 DE(DL)=4
        !             8:        S I=DP G GO
        !             9:        ;
        !            10: U      S D="",%=%+1,Y=$P(Z,C,%) Q:Y=""
        !            11:        S %(%)="D"_V(Y) I $D(V(Y,9)) F I=1:1:%-1 S %(I)="I("_V($P(Z,C,I))_",0)"
        !            12:        F I=1:1:% S D=D_C_%(I) I I=1 S D=D_C_DL
        !            13:        S DX(Y,U)=D_"))" G U
        !            14:        ;
        !            15: A      S W=$D(DPP(DL,X)),V(X)=DJ,Z(DL)=Z(DL)_X_C G ^DIOS1:'W
        !            16:        I W=1 S Z=X,V=DPP(DL,X),DJ=DJ+1,DPQ=DPQ+1,X=$O(DPP(DL,X)) S:X="" X=-1 S:+V'=V V=Q_V_Q S:$S($D(^DD(X,0,"UP")):^("UP")-Z,1:1) X=DX K J(DJ,X) S:J'<DJ&$D(J(DJ)) J=DJ-1 S J(DJ,X)=DL,V(X,1)=V,V(X,0)=Z,I(Z,X)=DL G A
        !            17:        S W=-1
        !            18: O      S W=$O(DPP(DL,X,W)) I W="" S X=+V G A
        !            19:        S V=DPP(DL,X,W),DJ=W#100,V(+V,9,DL)=W,V(+V,8)=U_$P(V,U,2),DPQ=DPQ+1+DJ,I(X,+V)=DL,J=-1,J(DJ,X)=DL G O
        !            20:        ;
        !            21: GO     K DISETP,DISAVX S X=I,I="" I $D(V(X,2)) S I=" X P("_X_")" I $D(DIBTPGM) S I=" D P"_DICP,DISETP=1
        !            22:        I V(X) S W="D"_V(X),I="F "_W_"="_W_":0"_I
        !            23:        S DX(X)=I,DPQ=X
        !            24:        S DX=X,I=$O(I(X,X)),F=-1 I I="" D  I I="" G DIO1
        !            25:        . I $D(I)<9 Q:'$D(DIBTPGM)  Q:$D(DISAVX(X))  S %=DX(X),%(1)=X,%(2)="DX" D SETU Q
        !            26:        . S I=$O(I(X,-1)) Q:I]""
        !            27:        . S I=$O(I(DP,-1)) I I]"" S DX=DP Q
        !            28:        . S DX=+$O(I(-1)),I=+$O(I(DX,-1))
        !            29:        . Q
        !            30:        S P=I(DX,I) K I(DX,I) G COLON:$D(V(I,9)) D MULPATH
        !            31:        S F="",(DX,%(0))=I,W="D"_V(I),%=DCC S:$D(DXIX(I)) F=DXIX(I) D:F="" GREF^DIOU(.V,.%,.F)
        !            32:        S DX(X)=DX(X)_" S "_D2_W_"=$O("_$E(F,1,$L(F)-2)_"0))"_DN_$P(")",U,'$D(DIBTPGM))_D1
        !            33:        I $D(DIBTPGM) S %=DX(X),%(1)=X,%(2)="DX" D SETU
        !            34:        G GO
        !            35: COLON  S F=$O(V(I,9,F)) I F="" G GO
        !            36:        D MULPATH S DX(X)=DX(X)_$E(" S "_D2,1,$S(D2]"":$L(D2)+2,1:0))_DN I '$D(DIBTPGM) S DX(X)=DX(X)_C_F_")"
        !            37:        S DX(X)=DX(X)_D1
        !            38:        I $D(DIBTPGM) S %=DX(X),%(1)=X,%(2)="DX" D SETU
        !            39:        S DN=DPP(F,DX,V(I,9,F)),V=$P(DN,U,4,99)
        !            40:        I $P(DN,U,3) S V="S DIXX="_I_" "_V
        !            41:        E  S V=V_" S D0=D(0) " D
        !            42:        .I '$D(DIBTPGM) S V=V_"X DX("_I_")" Q
        !            43:        .S V=V_"D DX"_DICDX
        !            44:        .Q
        !            45:        S DX(I,F)=V I $D(DIBTPGM) S %=V,%(1)=I_","_F,%(2)="DX" D SETU
        !            46:        G COLON
        !            47:        ;
        !            48: MULPATH        S DN=" "_$E("XD",$D(DIBTPGM)+1)_$P(":$T",1,$D(V(X,2)))_" DX" D
        !            49:        .I $D(DIBTPGM) S DN=DN_DICDX Q
        !            50:        .S DN=DN_"("_I Q
        !            51:        S (D1,D2)="" F Z=J+1:1:V(X) S W="D"_Z,D(X)="("_X_C_P_")",%=W_D(X),D2=%_"="_W_C_D2,D1=$S(D1]"":D1_C,1:" S ")_W_"="_%
        !            52:        F V=0:1 S Y=$S($D(J(V,X)):X,$O(J(V,-1)):$O(J(V,-1)),1:-1) D:$D(D(Y))  Q:V'<V(X)
        !            53:        . I V<V(X) S DN=" S D"_V_"=D"_V_D(Y)_DN
        !            54:        . Q:'$D(V(X,9))
        !            55:        . S:V=0 DN=" N I,DIXX"_DN
        !            56:        . Q:V<V(X)
        !            57:        . I $D(V(X,2)) S DN=" S D"_V_"=D"_V_D(Y)_DN
        !            58:        . Q
        !            59:        Q
        !            60:        ;
        !            61: SETU   ;FILE A LINE TO ^TMP FOR LATER INCLUSION IN ROUTINE
        !            62:        Q:%=""  N A
        !            63:        I %(2)="DX" S A=$S(DICDX=1:"O",1:"DX"_(DICDX-1)),DISAVX(X)=""
        !            64:        I %(2)'="DX" S A=%(2)_DICOV,DICOV=DICOV+1
        !            65:        S %=A_$E(" ",$E(%)'=" ")_%
        !            66:        S ^TMP("DIBTC",$J,%(1),DICNT)=%,^((DICNT+.001))=" Q"
        !            67:        S A="DIC"_%(2) S @(A)=@(A)+1,DICNT=DICNT+1
        !            68:        I %(2)="DX",$D(DISETP) S DICP(X)=DICP,DICP=DICP+1 K DISETP
        !            69:        Q
        !            70:        ;
        !            71: INIT   S:'$D(L) L=1 I $G(IO)=IO(0),L'=0,($G(IOST)=""!($G(IOST)?1"C".E)) D WAIT^DICD
        !            72:        K I,J,Z S J=99,Q="""",DE=DPP*8-$S($D(^DD("SUB")):^("SUB"),1:127)+23,D5=0,DIOS=$P(^DD("OS",DISYS,0),U,7) S:'DIOS DIOS=63
        !            73:        Q
        !            74:        ;
        !            75: DIO1   K %,I,J,P G ^DIO1