DIFG3A.m

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