| 1 | DIPR11 ;SFISC/MKO-PRE INSTALL ROUTINE FOR PATCH DI*22.0*11 ;2/15/00 10:22
|
|---|
| 2 | ;;22.0;VA FileMan;**11**;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ;Modify the trigger logic of fields that trigger fields with
|
|---|
| 6 | ;New-Style Indexes, so that they call ^DICR unconditionally,
|
|---|
| 7 | ;This ensures that New-Style Indexes on the triggered fields are
|
|---|
| 8 | ;are fired when the trigger logic is executed.
|
|---|
| 9 | ;Also, recompile any input templates that contain fields that trigger
|
|---|
| 10 | ;fields with new-style indexes.
|
|---|
| 11 | TRIG N FIL,FLD,NAM,OUT,TEM
|
|---|
| 12 | K ^TMP("DIPR11",$J)
|
|---|
| 13 | S FIL=.9999 F S FIL=$O(^DD("IX","F",FIL)) Q:'FIL D
|
|---|
| 14 | . S FLD=0 F S FLD=$O(^DD("IX","F",FIL,FLD)) Q:'FLD D
|
|---|
| 15 | .. Q:$D(^TMP("DIPR11",$J,FIL,FLD)) S ^(FLD)=""
|
|---|
| 16 | .. K OUT D TRMOD^DICR(FIL,FLD,.OUT) Q:'$D(OUT)
|
|---|
| 17 | .. M ^TMP("DIPR11",$J)=OUT
|
|---|
| 18 | ;
|
|---|
| 19 | S FIL=0 F S FIL=$O(^TMP("DIPR11",$J,FIL)) Q:'FIL D
|
|---|
| 20 | . S FLD=$O(^TMP("DIPR11",$J,FIL,FLD)) Q:'FLD D
|
|---|
| 21 | .. S TEM=0 F S TEM=$O(^DIE("AF",FIL,FLD,TEM)) Q:'TEM D
|
|---|
| 22 | ... Q:$D(^TMP("DIPR11",$J,"TEM",TEM)) S ^(TEM)=""
|
|---|
| 23 | ... S NAM=$G(^DIE(TEM,"ROUOLD")) Q:NAM=""
|
|---|
| 24 | ... D EN2^DIEZ(TEM,"",NAM)
|
|---|
| 25 | K ^TMP("DIPR11",$J)
|
|---|
| 26 | ;
|
|---|
| 27 | NODE0 ; Repair 0 node of INDEX and KEY files
|
|---|
| 28 | N I,DICNT,DILAST S DICNT=0,DILAST="",I=0
|
|---|
| 29 | F S I=$O(^DD("IX",I)) Q:'I I $D(^DD("IX",I,0))#2 S DICNT=DICNT+1,DILAST=I
|
|---|
| 30 | S $P(^DD("IX",0),"^",3,4)=DILAST_"^"_DICNT
|
|---|
| 31 | S DICNT=0,DILAST="",I=0
|
|---|
| 32 | F S I=$O(^DD("KEY",I)) Q:'I I $D(^DD("KEY",I,0))#2 S DICNT=DICNT+1,DILAST=I
|
|---|
| 33 | S $P(^DD("KEY",0),"^",3,4)=DILAST_"^"_DICNT
|
|---|
| 34 | Q
|
|---|
| 35 | ;
|
|---|
