Return to DIFG4A.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Annotation of freem_fileman/USER/DIFG4A.m, revision 1.1

1.1     ! snw         1: DIFG4A ;SFISC/DG(OHPRD)-CONDITIONALS ; [ 08/21/91  5:15 PM ]
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             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:        ;