| [613] | 1 | DICE1 ;SFISC/XAK-TRIGGER LOGIC ;10:24 AM 9 Jul 1999
|
|---|
| 2 | ;;22.0;VA FileMan;**6**;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | FIELD S %=DI,%F=DL,DOLD=$P(^DD(DI,DL,0),U) W !!,"WHEN THE " D WR^DIDH
|
|---|
| 5 | R "IS CHANGED,",!,"WHAT FIELD SHOULD BE 'TRIGGERED': ",X:DTIME Q:U[X
|
|---|
| 6 | I X?1."?" S DIC="^DD("_DI_",",DIC(0)="QE",DIC("S")="S %=$P(^(0),U,2) I %'[""C""&(%'[""W"")",DIC("W")="W:$P(^(0),U,2) "" (multiple)""" D ^DIC K DIC G FIELD
|
|---|
| 7 | F %=0:0 S %=$F(X," IN ") Q:'% S X=$E(X,1,%-5)_":"_$E(X,%,999),%=$F(X," FILE") S:% X=$E(X,1,%-6)_$E(X,%,999)
|
|---|
| 8 | F %=99:0 S %=$O(I(%)) Q:%="" K I(%),J(%)
|
|---|
| 9 | S %=-1,DCNEW=X,DICOMP="SW?",X="INTERNAL("_$P(X,":")_")"_$S($F(X,":"):":",1:"")_$P(X,":",2,99) D DA,DICOMP
|
|---|
| 10 | I '$D(X) S X=DCNEW,DICOMP="SW?" D DICOMP
|
|---|
| 11 | F %=9.2:.1 Q:'$D(X(%)) S ^UTILITY("DICE",$J,%+80)=X(%)
|
|---|
| 12 | I '$D(X)!'DICOMPX W !," ...",I,$C(7),!,"YOU MUST IDENTIFY SOME FIELD, EITHER WITHIN THE",!,"'",@("$P("_DIU_"0),U)"),"' FILE OR IN SOME OTHER" G FIELD
|
|---|
| 13 | S DFLD=X,DENEW=+$P(DICOMPX,U,2),DIN=+DICOMPX,DREF="",DLAY=Y["L"
|
|---|
| 14 | K X F X=Y\100*100:-100:0 F %=X:1 Q:'$D(J(%)) G CK:J(%)=DIN
|
|---|
| 15 | W $C(7),!,"SORRY, I AM CONFUSED" G FIELD
|
|---|
| 16 | CK I DENEW=.001 W $C(7),!,"CAN'T UPDATE A 'NUMBER' FIELD!" G FIELD
|
|---|
| 17 | I DENEW=DL,DIN=DI W $C(7),!,"CAN'T HAVE A FIELD TRIGGERING ITSELF!!!" G FIELD
|
|---|
| 18 | S DIFILE=J(X),DIAC="DD" D ^DIAC I '% W $C(7),!,"YOU DON'T HAVE 'DATA DEFINITION' ACCESS TO",!," THE '",$O(^DD(J(X),0,"NM",0)),"' FILE!" G FIELD
|
|---|
| 19 | I $P($G(^DD(J(X),0,"DI")),U,2)["Y" W $C(7),!,"CAN'T TRIGGER A RESTRICTED"_$S($P(^("DI"),U)["Y":" (ARCHIVE)",1:"")_" FILE!" G FIELD
|
|---|
| 20 | F X=X:1 S %=X#100,DREF=DREF_I(X)_$E(",",1,%)_"DIV("_%_"),",A=X S:$S('$D(J(%)):1,1:J(%)-J(X))&'$D(DICOMPX(0,J(X))) ^UTILITY("DICE",$J,"DIC")="LOOKUP" Q:J(X)=+DICOMPX!'$D(I(X+1))
|
|---|
| 21 | S DLOC=$P(^DD(DIN,DENEW,0),U,4),DSUB=$P(DLOC,";"),DLOC=$P(DLOC,";",2),DNEW=$P(^(0),U) S:+DSUB'=DSUB DSUB=""""_DSUB_""""
|
|---|
| 22 | I $P(^(0),U,2)["C" W !,$C(7),"CAN'T TRIGGER A COMPUTED FIELD!" G FIELD
|
|---|
| 23 | W " ...OK" K DIFILE,DIAC Q
|
|---|
| 24 | ;
|
|---|
| 25 | DA S DA="^DD("_DI_","_DL_",1,"_DQ_","_8 Q
|
|---|
| 26 | ;
|
|---|
| 27 | DICOMP ;
|
|---|
| 28 | S DICOMPX="",DICOMPX(0)="DIV(",DQI="Y(" G ^DICOMP
|
|---|
| 29 | ;
|
|---|
