- DICE1 ;SFISC/XAK-TRIGGER LOGIC ;10:24 AM 9 Jul 1999 [ 04/02/2003 8:25 AM ]
- ;;22.0;VA FileMan;**1001**;APR 1, 2003
- ;;22.0;VA FileMan;**6**;Mar 30, 1999
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- FIELD S %=DI,%F=DL,DOLD=$P(^DD(DI,DL,0),U) W !!,"WHEN THE " D WR^DIDH
- R "IS CHANGED,",!,"WHAT FIELD SHOULD BE 'TRIGGERED': ",X:DTIME Q:U[X
- 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
- 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)
- F %=99:0 S %=$O(I(%)) Q:%="" K I(%),J(%)
- S %=-1,DCNEW=X,DICOMP="SW?",X="INTERNAL("_$P(X,":")_")"_$S($F(X,":"):":",1:"")_$P(X,":",2,99) D DA,DICOMP
- I '$D(X) S X=DCNEW,DICOMP="SW?" D DICOMP
- F %=9.2:.1 Q:'$D(X(%)) S ^UTILITY("DICE",$J,%+80)=X(%)
- 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
- S DFLD=X,DENEW=+$P(DICOMPX,U,2),DIN=+DICOMPX,DREF="",DLAY=Y["L"
- K X F X=Y\100*100:-100:0 F %=X:1 Q:'$D(J(%)) G CK:J(%)=DIN
- W $C(7),!,"SORRY, I AM CONFUSED" G FIELD
- CK I DENEW=.001 W $C(7),!,"CAN'T UPDATE A 'NUMBER' FIELD!" G FIELD
- I DENEW=DL,DIN=DI W $C(7),!,"CAN'T HAVE A FIELD TRIGGERING ITSELF!!!" G FIELD
- 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
- 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
- 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))
- 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_""""
- I $P(^(0),U,2)["C" W !,$C(7),"CAN'T TRIGGER A COMPUTED FIELD!" G FIELD
- W " ...OK" K DIFILE,DIAC Q
- ;
- DA S DA="^DD("_DI_","_DL_",1,"_DQ_","_8 Q
- ;
- DICOMP ;
- S DICOMPX="",DICOMPX(0)="DIV(",DQI="Y(" G ^DICOMP
- ;
- DICE1 ;SFISC/XAK-TRIGGER LOGIC ;10:24 AM 9 Jul 1999 [ 04/02/2003 8:25 AM ]
- +1 ;;22.0;VA FileMan;**1001**;APR 1, 2003
- +2 ;;22.0;VA FileMan;**6**;Mar 30, 1999
- +3 ;Per VHA Directive 10-93-142, this routine should not be modified.
- FIELD SET %=DI
- SET %F=DL
- SET DOLD=$PIECE(^DD(DI,DL,0),U)
- WRITE !!,"WHEN THE "
- DO WR^DIDH
- +1 READ "IS CHANGED,",!,"WHAT FIELD SHOULD BE 'TRIGGERED': ",X:DTIME
- IF U[X
- QUIT
- +2 IF X?1."?"
- SET DIC="^DD("_DI_","
- SET DIC(0)="QE"
- SET DIC("S")="S %=$P(^(0),U,2) I %'[""C""&(%'[""W"")"
- SET DIC("W")="W:$P(^(0),U,2) "" (multiple)"""
- DO ^DIC
- KILL DIC
- GOTO FIELD
- +3 FOR %=0:0
- SET %=$FIND(X," IN ")
- IF '%
- QUIT
- SET X=$EXTRACT(X,1,%-5)_":"_$EXTRACT(X,%,999)
- SET %=$FIND(X," FILE")
- IF %
- SET X=$EXTRACT(X,1,%-6)_$EXTRACT(X,%,999)
- +4 FOR %=99:0
- SET %=$ORDER(I(%))
- IF %=""
- QUIT
- KILL I(%),J(%)
- +5 SET %=-1
- SET DCNEW=X
- SET DICOMP="SW?"
- SET X="INTERNAL("_$PIECE(X,":")_")"_$SELECT($FIND(X,":"):":",1:"")_$PIECE(X,":",2,99)
- DO DA
- DO DICOMP
- +6 IF '$DATA(X)
- SET X=DCNEW
- SET DICOMP="SW?"
- DO DICOMP
- +7 FOR %=9.2:.1
- IF '$DATA(X(%))
- QUIT
- SET ^UTILITY("DICE",$JOB,%+80)=X(%)
- +8 IF '$DATA(X)!'DICOMPX
- WRITE !," ...",I,$CHAR(7),!,"YOU MUST IDENTIFY SOME FIELD, EITHER WITHIN THE",!,"'",@("$P("_DIU_"0),U)"),"' FILE OR IN SOME OTHER"
- GOTO FIELD
- +9 SET DFLD=X
- SET DENEW=+$PIECE(DICOMPX,U,2)
- SET DIN=+DICOMPX
- SET DREF=""
- SET DLAY=Y["L"
- +10 KILL X
- FOR X=Y\100*100:-100:0
- FOR %=X:1
- IF '$DATA(J(%))
- QUIT
- IF J(%)=DIN
- GOTO CK
- +11 WRITE $CHAR(7),!,"SORRY, I AM CONFUSED"
- GOTO FIELD
- CK IF DENEW=.001
- WRITE $CHAR(7),!,"CAN'T UPDATE A 'NUMBER' FIELD!"
- GOTO FIELD
- +1 IF DENEW=DL
- IF DIN=DI
- WRITE $CHAR(7),!,"CAN'T HAVE A FIELD TRIGGERING ITSELF!!!"
- GOTO FIELD
- +2 SET DIFILE=J(X)
- SET DIAC="DD"
- DO ^DIAC
- IF '%
- WRITE $CHAR(7),!,"YOU DON'T HAVE 'DATA DEFINITION' ACCESS TO",!," THE '",$ORDER(^DD(J(X),0,"NM",0)),"' FILE!"
- GOTO FIELD
- +3 IF $PIECE($GET(^DD(J(X),0,"DI")),U,2)["Y"
- WRITE $CHAR(7),!,"CAN'T TRIGGER A RESTRICTED"_$SELECT($PIECE(^("DI"),U)["Y":" (ARCHIVE)",1:"")_" FILE!"
- GOTO FIELD
- +4 FOR X=X:1
- SET %=X#100
- SET DREF=DREF_I(X)_$EXTRACT(",",1,%)_"DIV("_%_"),"
- SET A=X
- IF $SELECT('$DATA(J(%))
- SET ^UTILITY("DICE",$JOB,"DIC")="LOOKUP"
- IF J(X)=+DICOMPX!'$DATA(I(X+1))
- QUIT
- +5 SET DLOC=$PIECE(^DD(DIN,DENEW,0),U,4)
- SET DSUB=$PIECE(DLOC,";")
- SET DLOC=$PIECE(DLOC,";",2)
- SET DNEW=$PIECE(^(0),U)
- IF +DSUB'=DSUB
- SET DSUB=""""_DSUB_""""
- +6 IF $PIECE(^(0),U,2)["C"
- WRITE !,$CHAR(7),"CAN'T TRIGGER A COMPUTED FIELD!"
- GOTO FIELD
- +7 WRITE " ...OK"
- KILL DIFILE,DIAC
- QUIT
- +8 ;
- DA SET DA="^DD("_DI_","_DL_",1,"_DQ_","_8
- QUIT
- +1 ;
- DICOMP ;
- +1 SET DICOMPX=""
- SET DICOMPX(0)="DIV("
- SET DQI="Y("
- GOTO ^DICOMP
- +2 ;
