Return to DIFG3.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIFG3.m, revision 1.1

1.1     ! snw         1: DIFG3  ;SFISC/DG(OHPRD)-LOOKUP PROCESSING ;3/11/93  1:33 PM
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        S DIFGTYP="" X DIFGLINE
        !             5:        N DIC,DIFGDRAD,DIFGDRCT,DIFGFLUS
        !             6:        S DIFG=DIFG+1
        !             7:        D BEGIN G:DIFGER X5
        !             8:        S DIFGTYP=$S(DIFGTYPE="MV FIELD":"MV FIELD",DIFGTYPE="SV FIELD":"SV FIELD",1:"FILE")
        !             9:        I $D(DIFGDINM) K DIFGDINM S Y=^UTILITY("DIFG",$J,DIFGINCR,DIC,"DA") S:'$D(@(^DIC(DIC,0,"GL")_"Y)")) DIFGER=19_U_DIFGY D ERROR^DIFG:DIFGER,SET^DIFG3A:'DIFGER G X5
        !            10:        I '$D(DIFGNOLK) D PREDIC I 1
        !            11:        E  I DIFGTYP="MV FIELD",$D(DIFGNOLK) D MVFIELD^DIFG3A I 1
        !            12:        E  S DIFGDIC=DIC D ^DIFG4,SET^DIFG3A
        !            13: X5     S DIFG=DIFG-1 K DIFGNOLK,DIFGCOND,DIFG("CONDSET") I DIFGTYP'="MV FIELD" K DIFGTYP
        !            14:        Q
        !            15: BEGIN  I $P(DIFGDIX,":")'="BEGIN" S DIFGER=6_U_DIFGY D ERROR^DIFG G X
        !            16:        S DIFGDRCT=0,DIC=$S(+$P(DIFGDIX,U,2):+$P(DIFGDIX,U,2),1:$O(^DIC("B",$P($P(DIFGDIX,U),":",2),""))),DIC("S")="F DIFGI=1:1 Q:'$D(DIFGDIC(DIFGDIC,DIFGI))!('$T)  X DIFGDIC(DIFGDIC,DIFGI)"
        !            17:        I '$D(^DD(DIC)) S DIFGER=20_U_DIFGY D ERROR^DIFG G X
        !            18:        I DIFGTYP="" S %=DIFGLAGO NEW DIFGLAGO S DIFGHAT=$P(^DD(DIC,.01,0),U,2) S DIFGLAGO=$S(%=0:0,DIFGHAT'["'":1,$D(DIFGENV("LAYGO",DIC,.01)):1,1:0) K %
        !            19:        K DIFGHAT
        !            20:        I DIFGTYPE="SV FIELD"!($D(DIFG("CHKCOND"))) S:$D(^DD(DIC,0,"FD")) DIFGCOND(DIFG,DIC)="" K DIFG("CHKCOND")
        !            21:        D LINK^DIFG5
        !            22:        F DIFGL=0:0 X DIFGLINE S DIFGFIRP=$P(DIFGDIX,":") Q:DIFGFIRP="END"!DIFGER  D LINES
        !            23:        Q
        !            24: LINES  I DIFGFIRP="BEGIN" D RCR S:$S($D(Y):Y<0,1:1) DIFGNOLK="" G:DIFGER X S:'$D(DIFGNOLK) X="`"_+Y S:$D(DIFGNOLK)&(DIFGTYP'="MV FIELD")&(DIFGTYP'="FILE") X=DIFGALNK D:$D(DIFGDIC(DIC))&'$D(DIFGNOLK) ARRAY^DIFG5 K Y G X
        !            25:        I DIFGFIRP="IDENTIFIER"!(DIFGFIRP="SPECIFIER") D ^DIFG0 G:DIFGER X S:'$D(DIFGPTER(DIFGCT)) DIFGSVVL(DIFGCT)=DIFGVAL(DIFGCT) I $D(DIFGPTER(DIFGCT)) D IDENSPEC^DIFG5 G X
        !            26:        I DIFGFIRP="KEY" S DIFGKEY="" D KEY^DIFG5
        !            27:        I DIFGFIRP="$DAT" S DIFGER=3_U_DIFGY D ERROR^DIFG
        !            28: X      Q
        !            29: RCR    N DIC,DIFGDRAD,DIFGDRCT,DIFGNOLK,DIFGFLUS
        !            30:        S DIFG=DIFG+1,DIFG("CHKCOND")=""
        !            31:        D BEGIN G:DIFGER X
        !            32:        I '$D(DIFGNOLK) D PREDIC I 1
        !            33:        E  S DIFGDIC=DIC D ^DIFG4,SET^DIFG3A
        !            34:        I $D(DIFGDIC)#2 K DIFGCOND(DIFG,DIFGDIC)
        !            35:        S DIFG=DIFG-1
        !            36:        Q
        !            37: PREDIC I $D(DIFGKEY) D:DIFGTYPE="MV FIELD" MVFIELD^DIFG3A G X2
        !            38:        S DIFGDIC=DIC
        !            39:        I DIFGTYP="MV FIELD" D MVFIELD^DIFG3A G X2
        !            40:        I DIFGTYP="FILE",$P(DIFGMO(DIFGMULT),U)="A" S DIFGSKIP(DIFGMULT)="" D ^DIFG4,SET^DIFG3A G X2
        !            41:        I '$D(DIFGFLUS) D CALLDIC I 1
        !            42:        E  D SET^DIFG3A
        !            43: X2     K DIFGKEY,DIFGSAVE(DIFG,"@NUM")
        !            44:        K:DIFGTYP'="MV FIELD" DIFG("ACGRV")
        !            45:        Q
        !            46: CALLDIC        K D
        !            47:        I $D(DIFGXRF(DIFGMULT)),(DIFGTYP="MV FIELD"!(DIFGTYP="FILE")) S DIFGX=X,X=^UTILITY("DIFG@",$J,$P(DIFGXRF(DIFGMULT),"=",2)) G:X["^UTILITY(""DIFG@""" NOLK S D=$P(DIFGXRF(DIFGMULT),"="),DIC(0)="FI" D  G:$D(DIFGNK) NOLK
        !            48:        . I $E(DIFGX)="`" S DIFGGRAV="",DIFGX=$E(DIFGX,2,245)
        !            49:        . E  NEW X S X=DIFGX X $P(^DD(DIFGDIC,.01,0),U,5,99) S:$D(X) DIFGX=X I '$D(X) S DIFGNK="" Q
        !            50:        . F DIFGI=1:1 Q:'$D(DIFGDIC(DIFGDIC,DIFGI))
        !            51:        . S DIFGDIC(DIFGDIC,DIFGI)="I $P(^(0),U)=DIFGX"
        !            52:        E  I $E(X)'="`"!($P(^DD(DIFGDIC,.01,0),U,5,99)["DINUM") S DIC(0)="MFI"
        !            53:        E  S X=$E(X,2,245),DIC(0)="FI",D="B",DIFG("ACGRV")=""
        !            54:        I $D(D),'$D(^DD(DIFGDIC,0,"IX",D)) D DOLO^DIFG5 I '$D(DIFG("FOUND")) S DIFGER=18_U_DIFGY D ERROR^DIFG G X6
        !            55:        K DIFGNK F DIFGI=1:1 Q:'$D(DIFGDIC(DIFGDIC,DIFGI))!$D(DIFGNK)  I $P(DIFGDIC(DIFGDIC,DIFGI),"=",2)["DIFGVAL",@$P(DIFGDIC(DIFGDIC,DIFGI),"=",2)["DIFG(" S DIFGNK=""
        !            56:        I '$D(DIFG("FOUND")),'$D(DIFGNK) D @$S($D(D):"IX^DIC",1:"^DIC")
        !            57: NOLK   I X["^UTILITY(""DIFG@"""!$D(DIFGNK) S Y=-1
        !            58:        I $D(DIFGX) S X=$S($D(DIFGGRAV):"`",1:"")_DIFGX K DIFGX,DIFGGRAV
        !            59:        D CHECKY^DIFG5
        !            60:        D:'DIFGER SET^DIFG3A
        !            61: X6     K DIFG("FOUND"),D,DR,DIFGNK
        !            62:        I DIFGTYP="MV FIELD"!(DIFGTYP="FILE") K DIFGXRF(DIFGMULT)
        !            63:        Q