Return to DIO0.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIO0.m, revision 1.1

1.1     ! snw         1: DIO0   ;SFISC/GFT,TKW-BUILD SORT AND SUB-HDR ;12/15/94  10:12
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        S Z=Z+1,DE=$P(DN,C,Z)_"=$O("_DI_$P(DN,C,1,Z)_")),DN="_(Z+1)
        !             5:        I Z=1,$G(DPP(DJK,"PTRIX"))]"" D
        !             6:        . S DE="DD0=$O("_DPP(DJK,"PTRIX")_"DD0)),DN=1.5,DD00=0"
        !             7:        . S DY(1.5)="S DD00=$O("_DPP(DJK,"PTRIX")_"DD0,DD00)),DN=2 S:'DD00 DN=1"
        !             8:        . I DPP(DJK,"PTRIX")?.E1"""B""," S DY(1.5)=DY(1.5)_" I DD00,$G(^(DD00))!('($D(^(DD00))=1)) S DN=1"
        !             9:        . Q
        !            10:        I DPQ,Z=1,$D(DPP(DJK,"IX")),$O(DPP(DJK,0)) D
        !            11:        .S DXIX=$P(DPP(DJK),U) Q:'DXIX  S DXIX(DXIX)=U_$P(DPP(DJK,"IX"),U,2)_$S($D(DPP(DJK,"PTRIX")):"DD00,D0",1:DN)
        !            12:        .S W=0,%(1)="" F %=0:0 S W=$O(DPP(DJK,W)) Q:'W  S %=%+1,%(1)=%(1)_C_"D"_%
        !            13:        .S DXIX(DXIX)=DXIX(DXIX)_%(1)
        !            14:        .K %,W Q
        !            15:        I Z<$G(DPP(0)) S Y=$P($G(DPP(Z+1,"F")),U) I Y]""!($G(DPP(Z+1,"T"))]"") S:+$P(Y,"E")'=Y Y=""""_Y_"""" S DE=DE_","_$P(DN,C,Z+1)_"="_Y
        !            16:        I 'DPQ,$D(DPP(Z)) D H
        !            17:        I DPQ,Z=DD S DE=DE_" S:D0 DISTP=DISTP+1 D:'(DISTP#100) CSTP"_$P("^DIO2",1,$D(DIBTPGM))_" Q:'DN "
        !            18:        S X=DE_" I "_$P(DN,C,Z)_$S(DD=Z:"'>0",1:"=""""")
        !            19:        S Y="" D
        !            20:        .I Z=1,$D(DPP(DJK,"T")),$D(DPP(DJK,"IX")) S Y=$P(DPP(DJK,"T"),U)
        !            21:        .I $G(DPP(0)),Z<(DPP(0)+1) S Y=$P($G(DPP(Z,"T")),U)
        !            22:        .I Y]"",Y'="@",Y'="z" S X=X_"!("_$$AFT^DIOC($P(DN,C,Z),Y)_")"
        !            23:        .Q
        !            24:        S X=X_" S DN="_$S(Z=DD&($D(DPP(DJK,"PTRIX"))):1.5,1:(Z-1)),Y=Z-1 I Z=1,$D(DPP(DJK,"PTRIX")) S X=X_" K DD00",$P(DN,C,1)="DD00"
        !            25:        I 'DPQ,$D(DPP(Y)) S:$P(DPP(Y),U,4)["!" X="DRK=DRK+1,"_X_",DRK=0",DRK=0 D SUB
        !            26:        S DY(Z)="S "_X
        !            27:        I $D(DIBTPGM) D
        !            28:        . S DY(Z)=$S(Z'=1:"DY"_Z,1:"EN")_" Q:'DN  "_DY(Z)_$S(Z=1:" Q",Z=2&($D(DPP(DJK,"PTRIX"))):" G DYP",Z=2:" G EN",1:" G DY"_(Z-1))
        !            29:        . I $D(DPP(DJK,"PTRIX")),Z=1 S DY(1.5)="DYP Q:'DN  "_DY(1.5)_" G EN"
        !            30:        . Q
        !            31:        G DIO0:Z<DD
        !            32:        F %=1:1 Q:'$D(DPP(%))  K DPP(%,"PTRIX")
        !            33:        S %=$S($G(DIO("SCR"))=1:"O",$D(DIS)<9:"O",$D(DIS)=11:"SCR",1:"SEARCH")
        !            34:        S DY(Z+1)="S DN="_Z_" " I DJ["""B"",^" S DY(Z+1)=DY(Z+1)_"I $D("_DI_$P(DN,C,1,Z)_"))=1,'^(D0) "
        !            35:        S DY(Z+1)=DY(Z+1)_"D "_%,Y=Z,X=""
        !            36:        I 'DPQ,$D(DPP(Y)),$P(DPP(Y),U,2)=0 D SUB I  S DY(Z+1)=DY(Z+1)_" S "_$E(X,2,99)
        !            37:        I A=1 D:$D(DIBTPGM) SETU Q
        !            38:        S X=C F W=1:1:A-1 S ^DOSV(0,IO(0),"BY",W)=DPP(A(W)),X=X_$P(DN,C,A(W))_C,A(W)="Q"
        !            39:        S A(W)="S ^DOSV(0,IO(0)"_C_W_X_"V,DE)=Y"
        !            40:        D:$D(DIBTPGM) SETU Q
        !            41:        ;
        !            42: SUB    I $P($G(DPP(Y)),U,4)["+" S A(A)=Y,X=X_",A="_A_" D"_$S($D(DIS)<9:"",1:":$D(DIPASS)")_" ^DIO3"_$S($D(DIS)<9:"",1:" K DIPASS"),A=A+1
        !            43:        Q
        !            44:        ;
        !            45: H      S DOP=0 I $D(DNP) F W=1:1 G Q:'$D(DPP(W)) I DPP(W)["+" K DNP S DOP=1 Q
        !            46:        S Y=$P(DN,C,Z),F=$P(DPP(Z),U,5),W=$P(DPP(Z),U,4),X=$P(W,"""",2),V=+$P(DPP(Z),U,2) S:W["-" Y="(999999999-"_Y_")" I F'[""""&'$D(DPQ(+DPP(Z),V+X))&'DOP!(W["@")!(W["'")!$D(DISH) S (Y,V)="" G F:F]"",U
        !            47:        S X=$S($D(^DD(+DPP(Z),V,0)):^(0),1:$P(DPP(Z),U,6,9)) I $P(X,U,2)["D" S Y=" S Y="_Y_" D DT"
        !            48:        E  I $G(DPP(Z,"OUT"))]"" S DPP(Z,"OUT")=" S Y="_Y_" "_DPP(Z,"OUT"),Y=",Y"
        !            49:        E  I $P(X,U,2)["O"!($P(X,U,4)?.P) S Y=C_Y
        !            50:        E  D ^DILL
        !            51:        S V=$P(F,";C",2),V="?"_$S(V:V-1,1:Z*3+5)
        !            52: F      I F[";S" S %=$P(F,";S",2) S:'% %=1 S V=$E("!!!!!!!!!!!!!!!!!!!!!!!!!!!!",1,%)_V,M=M+%
        !            53:        S F=$P(F,";""",2),%=$S(W["@":"",W["'":"",F]"":$P(F,"""",1,$L(F,"""")-1),Y]"":$P($P(DPP(Z),U,3),"""",1)_": ",1:""),Y=V_$S(%_Y]"":$E(",",V]"")_""""_%_"""",1:"")_Y I Y]"" S Y=" D T"_$G(DPP(Z,"OUT"))_" W "_Y
        !            54: U      S W=W'["#" I W,Y="",$D(DPP(Z+1)) G E
        !            55:        S ^UTILITY($J,"H",Z)="X ^UTILITY($J,1)"_$P(":$Y>"_(DIOSL-M-2-DD+Z)_"!(DC["","")",U,W)_Y,Y="D H:DI<DN ",DE=DE_$S(Z=1:",DI=0",1:" S:DI>"_Z_" DI="_Z)
        !            56:        S:^UTILITY($J,99,0)'[Y ^(0)=Y_^(0)
        !            57: E      I DOP S DNP=""
        !            58: Q      K DOP Q
        !            59:        ;
        !            60: SETU   ;PUT DY ARRAY INTO ^UTILITY FOR LATER COMPILATION
        !            61:        N DN
        !            62:        F DN=0:0 S DN=$O(DY(DN)) Q:'DN  D
        !            63:        .S ^TMP("DIBTC",$J,0,DICNT)=$E(" ",'$O(DY(DN)))_DY(DN),DICNT=DICNT+1
        !            64:        .I '$O(DY(DN)) S ^TMP("DIBTC",$J,0,DICNT)=$S(DN>2:" G DY"_(DN-1),1:" G EN"),DICNT=DICNT+1
        !            65:        .Q
        !            66:        Q