DIPR11.m

DIPR11 ;SFISC/MKO-PRE INSTALL ROUTINE FOR PATCH DI*22.0*11 ;2/15/00  10:22

 ;;22.0;VA FileMan;**11**;Mar 30, 1999

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 ;

 ;Modify the trigger logic of fields that trigger fields with

 ;New-Style Indexes, so that they call ^DICR unconditionally,

 ;This ensures that New-Style Indexes on the triggered fields are

 ;are fired when the trigger logic is executed.

 ;Also, recompile any input templates that contain fields that trigger

 ;fields with new-style indexes.

TRIG N FIL,FLD,NAM,OUT,TEM

 K ^TMP("DIPR11",$J)

 S FIL=.9999 F  S FIL=$O(^DD("IX","F",FIL)) Q:'FIL  D

 . S FLD=0 F  S FLD=$O(^DD("IX","F",FIL,FLD)) Q:'FLD  D

 .. Q:$D(^TMP("DIPR11",$J,FIL,FLD))  S ^(FLD)=""

 .. K OUT D TRMOD^DICR(FIL,FLD,.OUT) Q:'$D(OUT)

 .. M ^TMP("DIPR11",$J)=OUT

 ;

 S FIL=0 F  S FIL=$O(^TMP("DIPR11",$J,FIL)) Q:'FIL  D

 . S FLD=$O(^TMP("DIPR11",$J,FIL,FLD)) Q:'FLD  D

 .. S TEM=0 F  S TEM=$O(^DIE("AF",FIL,FLD,TEM)) Q:'TEM  D

 ... Q:$D(^TMP("DIPR11",$J,"TEM",TEM))  S ^(TEM)=""

 ... S NAM=$G(^DIE(TEM,"ROUOLD")) Q:NAM=""

 ... D EN2^DIEZ(TEM,"",NAM)

 K ^TMP("DIPR11",$J)

 ;

NODE0 ; Repair 0 node of INDEX and KEY files

 N I,DICNT,DILAST S DICNT=0,DILAST="",I=0

 F  S I=$O(^DD("IX",I)) Q:'I  I $D(^DD("IX",I,0))#2 S DICNT=DICNT+1,DILAST=I

 S $P(^DD("IX",0),"^",3,4)=DILAST_"^"_DICNT

 S DICNT=0,DILAST="",I=0

 F  S I=$O(^DD("KEY",I)) Q:'I  I $D(^DD("KEY",I,0))#2 S DICNT=DICNT+1,DILAST=I

 S $P(^DD("KEY",0),"^",3,4)=DILAST_"^"_DICNT

 Q

 ;

DIPR11    ;SFISC/MKO-PRE INSTALL ROUTINE FOR PATCH DI*22.0*11 ;2/15/00  10:22

 +1       ;;22.0;VA FileMan;**11**;Mar 30, 1999

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;

 +4       ;Modify the trigger logic of fields that trigger fields with

 +5       ;New-Style Indexes, so that they call ^DICR unconditionally,

 +6       ;This ensures that New-Style Indexes on the triggered fields are

 +7       ;are fired when the trigger logic is executed.

 +8       ;Also, recompile any input templates that contain fields that trigger

 +9       ;fields with new-style indexes.

TRIG       NEW FIL,FLD,NAM,OUT,TEM

 +1        KILL ^TMP("DIPR11",$JOB)

 +2        SET FIL=.9999

           FOR 

               SET FIL=$ORDER(^DD("IX","F",FIL))

               IF 'FIL

                   QUIT 

               Begin DoDot:1

 +3                SET FLD=0

                   FOR 

                       SET FLD=$ORDER(^DD("IX","F",FIL,FLD))

                       IF 'FLD

                           QUIT 

                       Begin DoDot:2

 +4                        IF $DATA(^TMP("DIPR11",$JOB,FIL,FLD))

                               QUIT 

                           SET ^(FLD)=""

 +5                        KILL OUT

                           DO TRMOD^DICR(FIL,FLD,.OUT)

                           IF '$DATA(OUT)

                               QUIT 

 +6                        MERGE ^TMP("DIPR11",$JOB)=OUT

                       End DoDot:2

               End DoDot:1

 +7       ;

 +8        SET FIL=0

           FOR 

               SET FIL=$ORDER(^TMP("DIPR11",$JOB,FIL))

               IF 'FIL

                   QUIT 

               Begin DoDot:1

 +9                SET FLD=$ORDER(^TMP("DIPR11",$JOB,FIL,FLD))

                   IF 'FLD

                       QUIT 

                   Begin DoDot:2

 +10                   SET TEM=0

                       FOR 

                           SET TEM=$ORDER(^DIE("AF",FIL,FLD,TEM))

                           IF 'TEM

                               QUIT 

                           Begin DoDot:3

 +11                           IF $DATA(^TMP("DIPR11",$JOB,"TEM",TEM))

                                   QUIT 

                               SET ^(TEM)=""

 +12                           SET NAM=$GET(^DIE(TEM,"ROUOLD"))

                               IF NAM=""

                                   QUIT 

 +13                           DO EN2^DIEZ(TEM,"",NAM)

                           End DoDot:3

                   End DoDot:2

               End DoDot:1

 +14       KILL ^TMP("DIPR11",$JOB)

 +15      ;

NODE0     ; Repair 0 node of INDEX and KEY files

 +1        NEW I,DICNT,DILAST

           SET DICNT=0

           SET DILAST=""

           SET I=0

 +2        FOR 

               SET I=$ORDER(^DD("IX",I))

               IF 'I

                   QUIT 

               IF $DATA(^DD("IX",I,0))#2

                   SET DICNT=DICNT+1

                   SET DILAST=I

 +3        SET $PIECE(^DD("IX",0),"^",3,4)=DILAST_"^"_DICNT

 +4        SET DICNT=0

           SET DILAST=""

           SET I=0

 +5        FOR 

               SET I=$ORDER(^DD("KEY",I))

               IF 'I

                   QUIT 

               IF $DATA(^DD("KEY",I,0))#2

                   SET DICNT=DICNT+1

                   SET DILAST=I

 +6        SET $PIECE(^DD("KEY",0),"^",3,4)=DILAST_"^"_DICNT

 +7        QUIT 

 +8       ;