- 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 Mar 13, 2025@21:58:01 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 ;
