| 1 | DIFG3A ;SFISC/DG(OHPRD)-SETS VARS BASED ON Y VALUE AFTER LOOKUP ;3/11/93 1:49 PM
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | SET ;SET VARIABLES BASED ON LOOKUP
|
|---|
| 5 | I $D(DIFGFLUS) S DIFGALNK=^UTILITY("DIFG@",$J,DIFGSAVE(DIFG,"@NUM")) I DIFGTYP="MV FIELD"!(DIFGTYP="FILE") S DIFGSKIP(DIFGMULT)=""
|
|---|
| 6 | E S (DIFGALNK,^UTILITY("DIFG@",$J,DIFGSAVE(DIFG,"@NUM")))=$S(($D(DIFGSKIP(DIFGMULT))&(DIFGTYP="MV FIELD"!(DIFGTYP="FILE")))!($S($D(Y):Y<0,1:1)):"^UTILITY(""DIFG@"","_$J_","""_DIFGSAVE(DIFG,"@NUM")_""")",1:+Y)
|
|---|
| 7 | I DIFGALNK S ^UTILITY("DIFGX",$J,DIFGSAVE(DIFG,"@NUM"))=X D EXTVAL
|
|---|
| 8 | I '$D(Y) S Y=-1
|
|---|
| 9 | I DIFGTYP="MV FIELD",$D(DIFGSKIP(DIFGMULT))
|
|---|
| 10 | E K:$D(DIFGDIC) DIFGDIC(DIFGDIC),DIFGDICS(DIFGDIC)
|
|---|
| 11 | Q
|
|---|
| 12 | ;
|
|---|
| 13 | EXTVAL ; Save external value
|
|---|
| 14 | K D
|
|---|
| 15 | I ($D(DIFG("ACGRV"))!($E(X)="`")),$D(Y),Y>0 K DIC("S") NEW Y S X=$S($E(X)="`":$E(X,2,245),1:X),DIC(0)="FIZ",D="B" D IX^DIC S:Y>0 ^UTILITY("DIFGX",$J,DIFGSAVE(DIFG,"@NUM"))=Y(0,0) I 1
|
|---|
| 16 | E I ($D(DIFG("ACGRV"))!($E(X)="`")),$S('$D(Y):1,Y<0:1,1:0) NEW DIC,Y S X=$S($E(X)="`":$E(X,2,245),1:X),DIC=+$P($P(^DD(DIFGDIC,.01,0),U,2),"P",2) I DIC S DIC(0)="FIZ",D="B" D IX^DIC S:Y>0 ^UTILITY("DIFGX",$J,DIFGSAVE(DIFG,"@NUM"))=Y(0,0)
|
|---|
| 17 | Q
|
|---|
| 18 | ;
|
|---|
| 19 | MVFIELD F DIFGI=DIFGMULT:-1:1 S DA(DIFGI)=$S(DIFGI=1:DA,1:DA(DIFGI-1))
|
|---|
| 20 | I $D(DIFGKEY) G X
|
|---|
| 21 | I $D(DIFGSKIP(DIFGMULT)) D SET G X
|
|---|
| 22 | I $P(DIFGMO(DIFGMULT),U)="A" S DIFGSKIP(DIFGMULT)="" D SET G X
|
|---|
| 23 | I '$D(DIFGFLUS) S DIC=DIFGMGBL(DIFGMULT),DIFGDIC=DIFGM(DIFGMULT) D CALLDIC^DIFG3 I 1
|
|---|
| 24 | E D SET
|
|---|
| 25 | X Q
|
|---|
