Return to DIQ1.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIQ1.m, revision 1.1

1.1     ! snw         1: DIQ1   ;SFISC/XAK-INQUIRY WITH COMPUTED FIELDS ;10/26/94  15:36
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        ;
        !             5:        S DIDQ=DD S:'$D(DICMX) DICMX="W !,O,"": "",X" N DD,D
        !             6: A      F DIQX=0:0 S DIQX=$O(^DD(DIDQ,DIQX)) Q:DIQX'>0  I $D(^(DIQX,0))#2 S Z=^(0),C=$P(Z,U,2),O=$P(Z,U)_" (c)" I C["C" X $P(Z,U,5,99) I X]"" S Y=X D W Q:'S
        !             7:        K DIDQ,DIQX,Z,DICMX Q
        !             8: W      I C["O",$D(^(2)) X ^(2)
        !             9:        I C["D" S %=$E(Y,4,5)*3,Y=$S(%:$E("JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC",%-2,%)_" ",1:"")_$S($E(Y,6,7):$J(+$E(Y,6,7),2)_", ",1:"")_($E(Y,1,3)+1700)_$S(Y[".":"  "_$E(Y_0,9,10)_":"_$E(Y_"000",11,12),1:"")
        !            10:        I $X>40!($L(O)+$L(Y)>36) S O=$E(O,1,253-$L(Y))
        !            11:        S O=O_": "_Y I  D LF^DIQ Q:'S
        !            12:        W:$X ?40 W O Q
        !            13:        Q
        !            14: EN     ;
        !            15:        Q:'$D(DIC)!($D(DA)[0)!($D(DR)[0)  S DIL=0,(DA(0),D0)=DA,DIQ0=""
        !            16:        I $D(DIQ)#2 G Q:DIQ["^"!($E(DIQ,1,2)="DI") S:DIQ'["(" DIQ=DIQ_"("
        !            17:        S:'$D(DIQ(0)) DIQ(0)="",DIQ0="DIQ(0),"
        !            18:        I $D(DIQ)[0 S DIQ="^UTILITY(""DIQ1"",$J,",DIQ0="DIQ,"
        !            19:        S DIQ0=DIQ0_"DIQ0"
        !            20:        I DIC S DIC=$S($D(^DIC(DIC,0,"GL")):^("GL"),1:"") G:DIC="" Q
        !            21: L      G Q:'$D(@(DIC_"0)")) S DI=+$P(^(0),U,2) G Q:'$D(^(DA,0))
        !            22:        N DII F DII=1:1 S DIQ1=$P(DR,";",DII) Q:DIQ1=""  D C:DIQ1[":",F:DIQ1>0
        !            23: Q      Q:DIL  K %,I,J,X,Y,C,DA(0),DRS,DIL,DI,DIQ1,@DIQ0
        !            24:        Q
        !            25:        ;
        !            26: C      S DIQ2=$P(DIQ1,":",2)
        !            27:        F DIQ1=DIQ1:0 D F S DIQ1=$O(^DD(DI,DIQ1)) I DIQ1'>0!(DIQ1'<DIQ2) S:DIQ1'=DIQ2 DIQ1=0 Q
        !            28:        Q
        !            29: F      Q:'$D(^DD(DI,DIQ1,0))
        !            30:        S Y=^(0),C=$P(Y,U,4),X=$P(C,";",2),C=$P(C,";"),J=$P(Y,U,2) G P:J["C"
        !            31:        I +C'=C S C=""""_C_""""
        !            32:        I X=0,$D(^DD(+J,.01,0)) G WD:$P(^(0),U,2)["W",S
        !            33:        S C=$G(@(DIC_DA_","_C_")")),Y=$S(X["E":$E(C,+$P(X,"E",2),+$P(X,",",2)),1:$P(C,U,X))
        !            34:        I DIQ(0)["I",(DIQ(0)["N"&(Y]"")!(DIQ(0)'["N")) S @(DIQ_"DI,DA,DIQ1,""I"")")=Y
        !            35: P      Q:DIQ(0)'["E"&(DIQ(0)["I")
        !            36:        I J["C" X $P(Y,U,5,999) K Y S Y=X D:J["D" D^DIQ
        !            37:        I J'["C" S C=$P(^DD(DI,DIQ1,0),U,2) D:Y]"" Y^DIQ
        !            38:        Q:Y=""&(DIQ(0)["N")
        !            39:        S @(DIQ_"DI,DA,DIQ1"_$S(DIQ(0)'["E":"",1:",""E""")_")")=Y
        !            40:        Q
        !            41: WD     F X=0:0 S X=$O(@(DIC_"DA,"_C_",X)")) Q:X'>0  S @(DIQ_"DI,DA,DIQ1,X)")=^(X,0)
        !            42:        Q
        !            43: S      ;
        !            44:        Q:'$D(DR(+J))  Q:'$D(DA(+J))  N DIQ1,I,DI S DIL=DIL+1
        !            45:        S DRS(DIL)=DR,DIC(DIL)=DIC,DR=DR(+J),DA(DIL)=DA
        !            46:        S DI=+J,DIC=DIC_DA_","_C_",",DA=DA(+J),@("D"_DIL)=DA
        !            47:        D L S DR=DRS(DIL),DA=DA(DIL),DIC=DIC(DIL)
        !            48:        K DRS(DIL),DIC(DIL),DA(DIL),@("D"_DIL)
        !            49:        S DIL=DIL-1 Q