Return to DIK1.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIK1.m, revision 1.1

1.1     ! snw         1: DIK1   ;SFISC/GFT-ACTUAL INDEXER ;8/24/94  13:15
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        D DI,K G Q:'$D(@(DIK_"0)"))
        !             5:        S Y=^(0),DH=$S($O(^(0))'>0:0,1:$P(Y,U,4)-1),X=$P($P(Y,U,3),U,DH>0) D 3:X=DA
        !             6:        S ^(0)=$P(Y,U,1,2)_U_X_U_DH
        !             7: Q      K:$G(DIKJ) ^UTILITY("DIK",DIKJ)
        !             8:        K DB(0),DIKJ,DIKS,DIN,DH,DU,DV,DW,DIKGP Q
        !             9:        ;
        !            10: K      S X="",Y=1 I $D(DIFKEP(DA))#2,DIK="^DIC(",$D(@(DIK_DA_",0,""GL"")")) S X=^("GL"),Y="^DIC("_DA_","
        !            11:        I X'=Y K @(DIK_"DA)"),X,Y Q
        !            12:        S X=DIK_"DA,",DH=@(X_"0)") K ^(0),^("%") S Y="""%""" F  S Y=$O(@(X_Y_")")) Q:$E(Y)'="%"  S Y=""""_Y_"""" K @(X_Y_")")
        !            13:        S @(X_"0)")=DH K X,Y
        !            14:        Q
        !            15:        ;
        !            16: 3      I X>1,$D(^(X-1)) S X=X-1 Q
        !            17:        S DV=1 F X=X:1 S X=X+DV,DV=DV+1 I $O(^(X))'>0 S DU=X-2,DV=1 Q
        !            18: L      S X=$O(^(DU)) Q:X>0  S DU=DU-DV,DV=DV+1 S:DU<0 DU=0 G L
        !            19:        ;
        !            20: DI     S (DIC,DIN)=DIK,DH=DH(DU),DV=1 F  S DV=$O(DA(DV)) Q:DV'>0  S DU=DU+1
        !            21: DIN    S DV=0 F  S DV=$O(^UTILITY("DIK",DIKJ,DH,DV)) Q:DV=""  D R:DV-.01
        !            22: DVA    S DV=$O(DV(DH,DV)) I DV="" S DV=.01 D R:$D(^UTILITY("DIK",DIKJ,DH,DV)) Q
        !            23:        S X=DIN_DA_","_DV(DH,DV) I @("'$D("_X_"))") G DVA
        !            24:        S DU(DU)=DIN,DIN=X_",",DH(DU)=DH,DH=DV(DH,DV,0),DV(DU)=DV,DU=DU+1 F X=DU:-1:1 I $D(DA(X)) S DA(X+1)=DA(X)
        !            25:        S DA(1)=DA,DA=0
        !            26: DA     S @("DA=$O("_DIN_"DA))") I DA>0 D DIN G DA
        !            27:        S DU=DU-1,DIN=DU(DU),DH=DH(DU),DV=DV(DU),DA=DA(1) K DA(1) F X=2:1 G DVA:'$D(DA(X)) S DA(X-1)=DA(X) K DA(X)
        !            28:        ;
        !            29: R      S X=^UTILITY("DIK",DIKJ,DH,DV),%=^(DV,0) I @("$D("_DIN_DA_",X))[0") Q
        !            30:        X % Q:X']""  S DIKS=X,DW=0
        !            31: XEC    S DW=$O(^UTILITY("DIK",DIKJ,DH,DV,DW)) Q:DW=""  X ^(DW) S X=DIKS G XEC
        !            32:        ;
        !            33: RCR    K Y,%RCR F %="DIKS","DIK","DW","DH","DIN","DU","DV","X" S %RCR(%)=""
        !            34:        S %RCR="RR^DIK1",Y=^UTILITY("DIK",DIKJ,DH,DV,DW,0) G STORLIST^%RCR
        !            35:        ;
        !            36: RR     X Y Q
        !            37:        ;
        !            38: AUDIT  N %,%F,%T,%D,DIKF,DIKDA S %=DV N DV S DV=%
        !            39:        S %F=DH,%=DU I $D(^DD(%F,0,"UP")) F %=1:1 Q:'$D(^DD(%F,0,"UP"))  S %D=%F,%F=^("UP"),DV(%)=$O(^DD(%F,"SB",%D,0)) S:DV(%)="" DV(%)=-1
        !            40:        S DIKDA="",DIKF="" F %=%-1:-1:1 S DIKDA=DIKDA_DA(%)_",",DIKF=DIKF_DV(%)_","
        !            41:        I $D(^DD(DH,DV,"AX")) X ^("AX") I '$T Q
        !            42:        G SET:$D(DIAU(DH,DV,DIKDA_DA))
        !            43:        D ADD^DIET S DIAU(DH,DV,DIKDA_DA)="^DIA("_%F_","_+Y_",",^DIA(%F,%D,0)=DIKDA_DA_U_%T_U_DIKF_DV_U_DUZ,^DIA(%F,"B",DIKDA_DA,%D)=""
        !            44: SET    N C S (%F,C)=$P(^DD(DH,DV,0),U,2),Y=X D Y^DIQ S @(DIAU(DH,DV,DIKDA_DA)_"DIIX)")=Y
        !            45:        I %F["P"!(%F["V")!(%F["S") S ^(DIIX+.1)=X_U_%F
        !            46:        Q
        !            47:        ;
        !            48: 1      ;
        !            49:        N DIKLK
        !            50:        S DIKLK=DIK_DA_")" L @("+"_DIKLK) D DI L @("-"_DIKLK) G Q
        !            51:        ;
        !            52: CNT    ;
        !            53:        N DIKLK,DIKLAST S DIKLAST=$S(DA:DA,1:"")
        !            54:        S DU=$E(DIK,1,$L(DIK)-1),DIKLK=$S(DIK[",":DU_")",1:DU) L @("+"_DIKLK)
        !            55: C      I @("$O("_DIK_"DA))'>0") S ^(0)=$P(@(DIK_"0)"),U,1,2)_U_DIKLAST_U_DCNT K DCNT L @("-"_DIKLK) G Q
        !            56:        S DA=$O(^(DA)) G C:$P($G(^(DA,0)),U)']"" S DIKLAST=DA,DU=1,DCNT=DCNT+1 S:DA="" DA=-1 D:(DCNT#100=0) WR D DI K DB(0) G C
        !            57: WR     I $D(IO)#2,$D(IO(0))#2,IO=IO(0),IO="" Q
        !            58:        W "." Q