DIFG4A.m

DIFG4A ;SFISC/DG(OHPRD)-CONDITIONALS ; [ 08/21/91  5:15 PM ]

 ;;22.0;VA FileMan;;Mar 30, 1999

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 ;

START ;

 D CHECK

 I $D(DIFGSTP) K DIFGSTP S DIFG("UNRESOLVED",DIFGSAVE(DIFG,"@NUM"))="" G X1

 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

 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)

 I X'["`" S ^UTILITY("DIFGFLD",$J,.01)=X

 K Y

 D COND ;dg/ohprd 8-21-91

 I '$D(Y) S Y=-1

 I Y>0 S DIFG("CONDSET")=""

 I Y=-1 S DIFGER=22_U_DIFGY D ERROR^DIFG

 K DIFGDRCT,DIFGDIGT,^UTILITY("DIFGFLD",$J)

X1 Q

 ;

CHECK ; Check for existence of higher level conds, if exist quit this level

 ; and continue processing

 NEW % S %=0 F  S %=$O(DIFGCOND(%)) S:%<DIFG&% DIFGSTP="" Q:%=""!(%<DIFG)

 Q

 ;

GETVAL ; Save field numbers and values

 I $D(^UTILITY("DIFGX",$J,DIFGDIGT)) S ^UTILITY("DIFGFLD",$J,DIFGNUMF(DIFGDIGT))=^(DIFGDIGT)

 Q

 ;

COND ; Execute conditions

 NEW ORDR,CNUM,NUM,STP,FLD,OP,VAL

 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)

 . S FLD=$P(^DD(DIFGDIC,0,"FD",CNUM,NUM),U),OP=$P(^(NUM),U,2),VAL=$P(^(NUM),U,3)

 . I $S('$D(^UTILITY("DIFGFLD",$J,FLD)):1,1:0) S STP="" Q

 . I @("^UTILITY(""DIFGFLD"",$J,FLD)"_OP_"VAL")

 . E  S STP=""

 Q

 ;

SETY ; Sets Y to value of "D" node or value from execution of "C" node

 I TYPE="M",$D(^DD(DIFGDIC,0,"FD",CNUM,"C")) X ^("C")

 I TYPE="F",$D(^DD(DIFGDIC,0,"FD",CNUM,"D")) S Y=^("D")

 I $D(Y),Y'>0 K Y

 E  I $D(Y),'$D(@(^DIC(DIFGDIC,0,"GL")_"Y)")) K Y

 Q

 ;

DIFG4A    ;SFISC/DG(OHPRD)-CONDITIONALS ; [ 08/21/91  5:15 PM ]

 +1       ;;22.0;VA FileMan;;Mar 30, 1999

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;

START     ;

 +1        DO CHECK

 +2        IF $DATA(DIFGSTP)

               KILL DIFGSTP

               SET DIFG("UNRESOLVED",DIFGSAVE(DIFG,"@NUM"))=""

               GOTO X1

 +3        SET DIFGDRCT=0

           FOR DIFGI=1:1

               IF '$DATA(DIFGDIC(DIFGDIC,DIFGI))

                   QUIT 

               SET DIFGDIGT=+$PIECE(DIFGDIC(DIFGDIC,DIFGI),"DIFGPC(",2)

               IF $DATA(DIFGNUMF(DIFGDIGT))

                   DO GETVAL

 +4        IF $EXTRACT(X)="`"

               IF $SELECT('$DATA(Y):1,Y<0:1,1:0)

                   NEW DIC

                   SET DIC=+$PIECE($PIECE(^DD(DIFGDIC,.01,0),U,2),"P",2)

                   IF DIC

                       SET DIC(0)="FMZ"

                       DO ^DIC

                       IF Y>0

                           SET X=Y(0,0)

 +5        IF X'["`"

               SET ^UTILITY("DIFGFLD",$JOB,.01)=X

 +6        KILL Y

 +7       ;dg/ohprd 8-21-91

           DO COND

 +8        IF '$DATA(Y)

               SET Y=-1

 +9        IF Y>0

               SET DIFG("CONDSET")=""

 +10       IF Y=-1

               SET DIFGER=22_U_DIFGY

               DO ERROR^DIFG

 +11       KILL DIFGDRCT,DIFGDIGT,^UTILITY("DIFGFLD",$JOB)

X1         QUIT 

 +1       ;

CHECK     ; Check for existence of higher level conds, if exist quit this level

 +1       ; and continue processing

 +2        NEW %

           SET %=0

           FOR 

               SET %=$ORDER(DIFGCOND(%))

               IF %<DIFG&%

                   SET DIFGSTP=""

               IF %=""!(%<DIFG)

                   QUIT 

 +3        QUIT 

 +4       ;

GETVAL    ; Save field numbers and values

 +1        IF $DATA(^UTILITY("DIFGX",$JOB,DIFGDIGT))

               SET ^UTILITY("DIFGFLD",$JOB,DIFGNUMF(DIFGDIGT))=^(DIFGDIGT)

 +2        QUIT 

 +3       ;

COND      ; Execute conditions

 +1        NEW ORDR,CNUM,NUM,STP,FLD,OP,VAL

 +2        FOR ORDR=0:0

               SET ORDR=$ORDER(^DD(DIFGDIC,0,"FD","B",ORDR))

               IF 'ORDR!$DATA(Y)

                   QUIT 

               SET CNUM=$ORDER(^(ORDR,""))

               SET TYPE=$PIECE(^DD(DIFGDIC,0,"FD",CNUM,0),U,3)

               KILL STP

               FOR NUM=0:0

                   SET NUM=$ORDER(^DD(DIFGDIC,0,"FD",CNUM,NUM))

                   IF NUM'=+NUM

                       DO SETY

                   IF NUM'=+NUM

                       QUIT 

                   Begin DoDot:1

 +3                    SET FLD=$PIECE(^DD(DIFGDIC,0,"FD",CNUM,NUM),U)

                       SET OP=$PIECE(^(NUM),U,2)

                       SET VAL=$PIECE(^(NUM),U,3)

 +4                    IF $SELECT('$DATA(^UTILITY("DIFGFLD",$JOB,FLD)):1,1:0)

                           SET STP=""

                           QUIT 

 +5                    IF @("^UTILITY(""DIFGFLD"",$J,FLD)"_OP_"VAL")

 +6                   IF '$TEST

                           SET STP=""

                   End DoDot:1

                   IF $DATA(STP)

                       QUIT 

 +7        QUIT 

 +8       ;

SETY      ; Sets Y to value of "D" node or value from execution of "C" node

 +1        IF TYPE="M"

               IF $DATA(^DD(DIFGDIC,0,"FD",CNUM,"C"))

                   XECUTE ^("C")

 +2        IF TYPE="F"

               IF $DATA(^DD(DIFGDIC,0,"FD",CNUM,"D"))

                   SET Y=^("D")

 +3        IF $DATA(Y)

               IF Y'>0

                   KILL Y

 +4       IF '$TEST

               IF $DATA(Y)

                   IF '$DATA(@(^DIC(DIFGDIC,0,"GL")_"Y)"))

                       KILL Y

 +5        QUIT 

 +6       ;