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;Build 1
;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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIPR11 1527 printed Oct 16, 2024@18:53:42 Page 2
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;Build 1
+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 ;
