DIFG4A ;SFISC/DG(OHPRD)-CONDITIONALS ;08/21/91 5:15 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.
;
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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIFG4A 2052 printed Oct 16, 2024@18:48:14 Page 2
DIFG4A ;SFISC/DG(OHPRD)-CONDITIONALS ;08/21/91 5:15 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 ;
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 ;
