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

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

initial load of WorldVistAEHR

File size: 2.3 KB
RevLine 
[613]1DITMU4 ;SFISC/EDE(OHPRD)-FIX ALL "PT" NODES ;
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; This routine fixes all "PT" nodes for files 1 through the
6 ; highest file number in the current UCI.
7 ;
8START ;
9 W:'$D(DITMU4("NOTALK")) !!,"This routine insures the ""PT"" node of each FileMan file is correct.",!
10 W:'$D(DITMU4("NOTALK")) !!,"Now checking false positives.",!
11 S U="^"
12 S DITMU4FI=.99999999 F DITMU4L=0:0 S DITMU4FI=$O(^DD(DITMU4FI)) Q:DITMU4FI'=+DITMU4FI I $D(^DD(DITMU4FI,0,"PT")) W:'$D(DITMU4("NOTALK")) !,DITMU4FI D FPOS
13 W:'$D(DITMU4("NOTALK")) !!,"Now checking false negatives.",!
14 D FNEG
15 K DITMU4FI,DITMU4L
16 W:'$D(DITMU4("NOTALK")) !!,"DONE",!
17 Q
18 ;
19FPOS ; CHECK FOR FALSE POSITIVES
20 S DITMU4PF="" F DITMU4L=0:0 S DITMU4PF=$O(^DD(DITMU4FI,0,"PT",DITMU4PF)) Q:DITMU4PF="" S DITMU4PD="" F DITMU4L=0:0 S DITMU4PD=$O(^DD(DITMU4FI,0,"PT",DITMU4PF,DITMU4PD)) Q:DITMU4PD="" D CHKIT
21 K DITMU4PF,DITMU4PD,DITMU4X
22 Q
23 ;
24CHKIT ;
25 W:'$D(DITMU4("NOTALK")) "."
26 I '$D(^DD(DITMU4PF)) W:'$D(DITMU4("NOTALK")) "|" K ^DD(DITMU4FI,0,"PT",DITMU4PF) Q
27 I '$D(^DD(DITMU4PF,DITMU4PD,0)) W:'$D(DITMU4("NOTALK")) "|" K ^DD(DITMU4FI,0,"PT",DITMU4PF,DITMU4PD) Q
28 S DITMU4X=$P(^DD(DITMU4PF,DITMU4PD,0),U,2)
29 I DITMU4X["P",DITMU4X[DITMU4FI Q
30 I DITMU4X["V",$D(^DD(DITMU4PF,DITMU4PD,"V","B",DITMU4FI)) Q
31 W:'$D(DITMU4("NOTALK")) "|" K ^DD(DITMU4FI,0,"PT",DITMU4PF,DITMU4PD)
32 Q
33 ;
34FNEG ; CHECK FOR FALSE NEGATIVES
35 S DITMU4FI=.99999999 F DITMU4L=0:0 S DITMU4FI=$O(^DD(DITMU4FI)) Q:DITMU4FI'=+DITMU4FI W:'$D(DITMU4("NOTALK")) !,DITMU4FI S DITMU4FD=0 F DITMU4L=0:0 S DITMU4FD=$O(^DD(DITMU4FI,DITMU4FD)) Q:DITMU4FD'=+DITMU4FD D:$D(^(DITMU4FD,0))#2 PTRCHK
36 K DITMU4FI,DITMU4FD,DITMU4X,DITMU4I
37 Q
38 ;
39PTRCHK ;
40 S DITMU4X=$P(^(0),U,2)
41 I DITMU4X["V" D PTRCHK2 Q
42 Q:DITMU4X'["P"
43 F DITMU4I=1:1:$L(DITMU4X)+1 Q:$E(DITMU4X,DITMU4I)?1N
44 Q:DITMU4I>$L(DITMU4X)
45 S DITMU4X=$E(DITMU4X,DITMU4I,999),DITMU4X=+DITMU4X
46 Q:'DITMU4X
47 Q:DITMU4X<1 ;*** DOES NOT MESS WITH FILE NUMBERS < 1 ***
48 W:'$D(DITMU4("NOTALK")) "."
49 Q:'$D(^DIC(DITMU4X))
50 Q:'$D(^DD(DITMU4X,0))
51 I '$D(^DD(DITMU4X,0,"PT",DITMU4FI,DITMU4FD)) W "|" S ^(DITMU4FD)=""
52 Q
53 ;
54PTRCHK2 ; VARIABLE POINTER CHECK
55 S DITMU4X="" F DITMU4L=0:0 S DITMU4X=$O(^DD(DITMU4FI,DITMU4FD,"V","B",DITMU4X)) Q:DITMU4X="" I '$D(^DD(DITMU4X,0,"PT",DITMU4FI,DITMU4FD)) W:'$D(DITMU4("NOTALK")) "|" S ^(DITMU4FD)=""
56 Q
Note: See TracBrowser for help on using the repository browser.