DIFG3A ;SFISC/DG(OHPRD)-SETS VARS BASED ON Y VALUE AFTER LOOKUP ;3/11/93 1:49 PM
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIFG3A 1735 printed Oct 16, 2024@18:48:12 Page 2
DIFG3A ;SFISC/DG(OHPRD)-SETS VARS BASED ON Y VALUE AFTER LOOKUP ;3/11/93 1:49 PM
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
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
