Return to DIFG2.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIFG2.m, revision 1.1

1.1     ! snw         1: DIFG2  ;SFISC/DG(OHPRD)-PROCESSING OF MULTIPLES FROM FILEGRAM ; [ 02/02/93  4:21 PM ]
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4: START  ;CALLED BY DIFG
        !             5:        S DIFG=DIFG+1
        !             6:        I DIFGMULT=0 S DIFGNDC=0,DIFGM(0)=DIC ;ENTERING HIGHEST LEVEL MULTIPLE
        !             7:        N DIC
        !             8:        D MULT
        !             9:        I DIFGER G X1
        !            10:        I '$D(DIFG("NOLKUP")) D ^DIFG3 I 1
        !            11:        E  D NOLOOK
        !            12:        I DIFGER G X1
        !            13:        D SET
        !            14:        K DIFGALNK,DIFGMLND,DIFGPC,DIFGFLD,DIFGVAL,DIFGDOL,DIFGNUMF,DIFGNOLK,DIFGLAGO,Y,DIFG("NOLKUP"),DIFG("ACGRV"),DIFGDIC(DIFGDIC)
        !            15:        D FILE^DIFG
        !            16:        K DIFGSKIP(DIFGMULT) ;Going up one level so kill this variable which tells lower level multiples not to do lookup
        !            17:        D CHANGEDA
        !            18:        S DIFG=DIFG-1
        !            19: X1     Q
        !            20:        ;
        !            21: MULT   ;MULTIPLE FIELD LOOKUP AND CALL TO SET DR STRING FOR MULTIPLE
        !            22:        I DIFGMULT=0 S DIFGMGBL(DIFGMULT)=$S(DIFGM(0):^DIC(DIFGM(0),0,"GL"),1:DIC),DIFGDA(DIFGMULT)=DA
        !            23:        S DIFGNODE=$P($P(DIFGMLND,"^",4),";")
        !            24:        S DIFGLAGO=0
        !            25:        I $P(^DD(DIFGNUM,.01,0),U,2)'["'"!($D(DIFGENV("LAYGO",DIFGNUM,.01))) S DIFGLAGO=1 ;Not a ptr or a ptr and laygo allowed
        !            26:        S DIFGMULT=DIFGMULT+1
        !            27:        I $D(DIFGSKIP(DIFGMULT-1)) S DIFGSKIP(DIFGMULT)=""
        !            28:        S DIFGMGBL(DIFGMULT)=DIFGMGBL(DIFGMULT-1)_DIFGDA(DIFGMULT-1)_","_""""_DIFGNODE_""""_","
        !            29:        S DIFGM(DIFGMULT)=DIFGNUM
        !            30:        S DIC=DIFGNUM D BASE^DIFG0 Q:DIFGER  D FUNC^DIFG0
        !            31:        Q
        !            32:        ;
        !            33: NOLOOK ;IF NO LOOKUP REQUIRED, SET DA ARRAY
        !            34:        F DIFGI=DIFGMULT:-1:1 S DA(DIFGI)=$S(DIFGI=1:DA,1:DA(DIFGI-1))
        !            35:        Q
        !            36:        ;
        !            37: SET    ;
        !            38:        I '$D(DIFGSKIP(DIFGMULT)) S (DA,DIFGDA(DIFGMULT))=+Y
        !            39:        E  S (DA,DIFGDA(DIFGMULT))=DIFGALNK I '$D(DIFGFLUS) D
        !            40:        . S ^UTILITY("DIFG",$J,DIFGINCR,DIC,"X")=$S($E(X)="`":$E(X,2,245)_"^N",($D(DIFG("ACGRV"))!(X[("^UTILITY(""DIFG@"","_$J))):X_"^N",1:X_"^"),^("MODE")="A"_"^"_$P(^("MODE"),U,2),^("DIC(""P"")")=$P(DIFGMLND,U,2)
        !            41:        S DIC=DIFGM(DIFGMULT)
        !            42:        S ^UTILITY("DIFG",$J,DIFGINCR,DIC,"DA")=DA,^("GL")=DIFGMGBL(DIFGMULT),^($S($D(DIFGSKIP(DIFGMULT))&('$D(DIFGFLUS)):"DIC(""DR"")",1:"DR"))="" F DIFGI=1:1:DIFGMULT S ^("DA("_DIFGI_")")=DA(DIFGI)
        !            43:        I $D(DIFGSKIP(DIFGMULT)),'$D(DIFGFLUS) D ENADD^DIFG4
        !            44:        K DIFGTYP,DIFGFLUS ;DIFGTYP exists due to DIFG3 not killing it if DIFGTYP="MV FIELD" - Needed in case one calls ENADD^DIFG4
        !            45:        Q
        !            46:        ;
        !            47: CHANGEDA       ;BACK DOWN ONE LEVEL DA'S, I.E. DA=DA(1),DA(1)=DA(2) ETC.
        !            48:        S DA=DA(1)
        !            49:        I DIFGMULT>1 F DIFGI=DIFGMULT:-1:2 S DA(DIFGI-1)=DA(DIFGI)
        !            50:        K DA(DIFGMULT)
        !            51:        S DIFGMULT=DIFGMULT-1
        !            52:        Q
        !            53:        ;