Return to DIFG2.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    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: 	;