| 1 | DIFG4A ;SFISC/DG(OHPRD)-CONDITIONALS ; [ 08/21/91 5:15 PM ]
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | START ;
|
|---|
| 6 | D CHECK
|
|---|
| 7 | I $D(DIFGSTP) K DIFGSTP S DIFG("UNRESOLVED",DIFGSAVE(DIFG,"@NUM"))="" G X1
|
|---|
| 8 | S DIFGDRCT=0 F DIFGI=1:1 Q:'$D(DIFGDIC(DIFGDIC,DIFGI)) S DIFGDIGT=+$P(DIFGDIC(DIFGDIC,DIFGI),"DIFGPC(",2) D:$D(DIFGNUMF(DIFGDIGT)) GETVAL
|
|---|
| 9 | I $E(X)="`",$S('$D(Y):1,Y<0:1,1:0) NEW DIC S DIC=+$P($P(^DD(DIFGDIC,.01,0),U,2),"P",2) I DIC S DIC(0)="FMZ" D ^DIC S:Y>0 X=Y(0,0)
|
|---|
| 10 | I X'["`" S ^UTILITY("DIFGFLD",$J,.01)=X
|
|---|
| 11 | K Y
|
|---|
| 12 | D COND ;dg/ohprd 8-21-91
|
|---|
| 13 | I '$D(Y) S Y=-1
|
|---|
| 14 | I Y>0 S DIFG("CONDSET")=""
|
|---|
| 15 | I Y=-1 S DIFGER=22_U_DIFGY D ERROR^DIFG
|
|---|
| 16 | K DIFGDRCT,DIFGDIGT,^UTILITY("DIFGFLD",$J)
|
|---|
| 17 | X1 Q
|
|---|
| 18 | ;
|
|---|
| 19 | CHECK ; Check for existence of higher level conds, if exist quit this level
|
|---|
| 20 | ; and continue processing
|
|---|
| 21 | NEW % S %=0 F S %=$O(DIFGCOND(%)) S:%<DIFG&% DIFGSTP="" Q:%=""!(%<DIFG)
|
|---|
| 22 | Q
|
|---|
| 23 | ;
|
|---|
| 24 | GETVAL ; Save field numbers and values
|
|---|
| 25 | I $D(^UTILITY("DIFGX",$J,DIFGDIGT)) S ^UTILITY("DIFGFLD",$J,DIFGNUMF(DIFGDIGT))=^(DIFGDIGT)
|
|---|
| 26 | Q
|
|---|
| 27 | ;
|
|---|
| 28 | COND ; Execute conditions
|
|---|
| 29 | NEW ORDR,CNUM,NUM,STP,FLD,OP,VAL
|
|---|
| 30 | F ORDR=0:0 S ORDR=$O(^DD(DIFGDIC,0,"FD","B",ORDR)) Q:'ORDR!$D(Y) S CNUM=$O(^(ORDR,"")),TYPE=$P(^DD(DIFGDIC,0,"FD",CNUM,0),U,3) K STP F NUM=0:0 S NUM=$O(^DD(DIFGDIC,0,"FD",CNUM,NUM)) D:NUM'=+NUM SETY Q:NUM'=+NUM D Q:$D(STP)
|
|---|
| 31 | . S FLD=$P(^DD(DIFGDIC,0,"FD",CNUM,NUM),U),OP=$P(^(NUM),U,2),VAL=$P(^(NUM),U,3)
|
|---|
| 32 | . I $S('$D(^UTILITY("DIFGFLD",$J,FLD)):1,1:0) S STP="" Q
|
|---|
| 33 | . I @("^UTILITY(""DIFGFLD"",$J,FLD)"_OP_"VAL")
|
|---|
| 34 | . E S STP=""
|
|---|
| 35 | Q
|
|---|
| 36 | ;
|
|---|
| 37 | SETY ; Sets Y to value of "D" node or value from execution of "C" node
|
|---|
| 38 | I TYPE="M",$D(^DD(DIFGDIC,0,"FD",CNUM,"C")) X ^("C")
|
|---|
| 39 | I TYPE="F",$D(^DD(DIFGDIC,0,"FD",CNUM,"D")) S Y=^("D")
|
|---|
| 40 | I $D(Y),Y'>0 K Y
|
|---|
| 41 | E I $D(Y),'$D(@(^DIC(DIFGDIC,0,"GL")_"Y)")) K Y
|
|---|
| 42 | Q
|
|---|
| 43 | ;
|
|---|
