source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIPR11.m@ 1361

Last change on this file since 1361 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.4 KB
RevLine 
[613]1DIPR11 ;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.
11TRIG 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 ;
27NODE0 ; 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 ;
Note: See TracBrowser for help on using the repository browser.