- DIFG3A ;SFISC/DG(OHPRD)-SETS VARS BASED ON Y VALUE AFTER LOOKUP ;3/11/93 1:49 PM
- ;;22.0;VA FileMan;;Mar 30, 1999
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- SET ;SET VARIABLES BASED ON LOOKUP
- I $D(DIFGFLUS) S DIFGALNK=^UTILITY("DIFG@",$J,DIFGSAVE(DIFG,"@NUM")) I DIFGTYP="MV FIELD"!(DIFGTYP="FILE") S DIFGSKIP(DIFGMULT)=""
- 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)
- I DIFGALNK S ^UTILITY("DIFGX",$J,DIFGSAVE(DIFG,"@NUM"))=X D EXTVAL
- I '$D(Y) S Y=-1
- I DIFGTYP="MV FIELD",$D(DIFGSKIP(DIFGMULT))
- E K:$D(DIFGDIC) DIFGDIC(DIFGDIC),DIFGDICS(DIFGDIC)
- Q
- ;
- EXTVAL ; Save external value
- K D
- 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
- 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)
- Q
- ;
- MVFIELD F DIFGI=DIFGMULT:-1:1 S DA(DIFGI)=$S(DIFGI=1:DA,1:DA(DIFGI-1))
- I $D(DIFGKEY) G X
- I $D(DIFGSKIP(DIFGMULT)) D SET G X
- I $P(DIFGMO(DIFGMULT),U)="A" S DIFGSKIP(DIFGMULT)="" D SET G X
- I '$D(DIFGFLUS) S DIC=DIFGMGBL(DIFGMULT),DIFGDIC=DIFGM(DIFGMULT) D CALLDIC^DIFG3 I 1
- E D SET
- X Q
- DIFG3A ;SFISC/DG(OHPRD)-SETS VARS BASED ON Y VALUE AFTER LOOKUP ;3/11/93 1:49 PM
- +1 ;;22.0;VA FileMan;;Mar 30, 1999
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- SET ;SET VARIABLES BASED ON LOOKUP
- +1 IF $DATA(DIFGFLUS)
- SET DIFGALNK=^UTILITY("DIFG@",$JOB,DIFGSAVE(DIFG,"@NUM"))
- IF DIFGTYP="MV FIELD"!(DIFGTYP="FILE")
- SET DIFGSKIP(DIFGMULT)=""
- +2 IF '$TEST
- SET (DIFGALNK,^UTILITY("DIFG@",$JOB,DIFGSAVE(DIFG,"@NUM")))=$SELECT(($DATA(DIFGSKIP(DIFGMULT))&(DIFGTYP="MV FIELD"!(DIFGTYP="FILE")))!($SELECT($DATA(Y):Y<0,1:1)):"^UTILITY(""DIFG@"","_$JOB_","""_DIFGSAVE(DIFG,"@NUM")_""")",1:+Y)
- +3 IF DIFGALNK
- SET ^UTILITY("DIFGX",$JOB,DIFGSAVE(DIFG,"@NUM"))=X
- DO EXTVAL
- +4 IF '$DATA(Y)
- SET Y=-1
- +5 IF DIFGTYP="MV FIELD"
- IF $DATA(DIFGSKIP(DIFGMULT))
- +6 IF '$TEST
- IF $DATA(DIFGDIC)
- KILL DIFGDIC(DIFGDIC),DIFGDICS(DIFGDIC)
- +7 QUIT
- +8 ;
- EXTVAL ; Save external value
- +1 KILL D
- +2 IF ($DATA(DIFG("ACGRV"))!($EXTRACT(X)="`"))
- IF $DATA(Y)
- IF Y>0
- KILL DIC("S")
- NEW Y
- SET X=$SELECT($EXTRACT(X)="`":$EXTRACT(X,2,245),1:X)
- SET DIC(0)="FIZ"
- SET D="B"
- DO IX^DIC
- IF Y>0
- SET ^UTILITY("DIFGX",$JOB,DIFGSAVE(DIFG,"@NUM"))=Y(0,0)
- IF 1
- +3 IF '$TEST
- IF ($DATA(DIFG("ACGRV"))!($EXTRACT(X)="`"))
- IF $SELECT('$DATA(Y):1,Y<0:1,1:0)
- NEW DIC,Y
- SET X=$SELECT($EXTRACT(X)="`":$EXTRACT(X,2,245),1:X)
- SET DIC=+$PIECE($PIECE(^DD(DIFGDIC,.01,0),U,2),"P",2)
- IF DIC
- SET DIC(0)="FIZ"
- SET D="B"
- DO IX^DIC
- IF Y>0
- SET ^UTILITY("DIFGX",$JOB,DIFGSAVE(DIFG,"@NUM"))=Y(0,0)
- +4 QUIT
- +5 ;
- MVFIELD FOR DIFGI=DIFGMULT:-1:1
- SET DA(DIFGI)=$SELECT(DIFGI=1:DA,1:DA(DIFGI-1))
- +1 IF $DATA(DIFGKEY)
- GOTO X
- +2 IF $DATA(DIFGSKIP(DIFGMULT))
- DO SET
- GOTO X
- +3 IF $PIECE(DIFGMO(DIFGMULT),U)="A"
- SET DIFGSKIP(DIFGMULT)=""
- DO SET
- GOTO X
- +4 IF '$DATA(DIFGFLUS)
- SET DIC=DIFGMGBL(DIFGMULT)
- SET DIFGDIC=DIFGM(DIFGMULT)
- DO CALLDIC^DIFG3
- IF 1
- +5 IF '$TEST
- DO SET
- X QUIT
