source: FOIAVistA/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DDUCHK3.m@ 1806

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

initial load of FOIAVistA 6/30/08 version

File size: 3.0 KB
Line 
1DDUCHK3 ;SFISC/RWF-CHECK DD (XREF,COMPUTED) ;12:40 PM 4 Mar 2004
2 ;;22.0;VA FileMan;**130**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4XREF F DDUCY=0:0 S DDUCY=$O(^DD(DDUCFI,DDUCFE,1,DDUCY)) Q:DDUCY'>0 S DDUCX=^(DDUCY,0),DDUCRFI=+DDUCX,DDUCX1=$P(DDUCX,U,2) D XREF1
5 Q
6XREF1 ;
7 I DDUCRFI,$D(^DD(DDUCRFI,0)),$D(^DD(DDUCRFI,0,"IX",DDUCX1,DDUCFI,DDUCFE))[0 D WHO,WFI W "missing 'IX' node." D:DDUCFIX XREFM Q
8 I DDUCX["TRIGGER" S DDUCRFI=+$P(DDUCX,U,4),DDUCRFE=+$P(DDUCX,U,5),DDUC5=DDUCFI_U_DDUCFE_U_DDUCY D TRIG
9 Q
10XREFM S ^DD(DDUCRFI,0,"IX",DDUCX1,DDUCFI,DDUCFE)="" W !?10,"^DD(",DDUCRFI,",0,""IX"",""",DDUCX1,""",",DDUCFI,",",DDUCFE,") = """" was set."
11 Q
12TRIG I $D(^DD(DDUCRFI,0))[0 W !?5,"Field: ",DDUCFE," (",DDUCXN,") triggers missing file ",DDUCRFI Q
13 I $D(^DD(DDUCRFI,DDUCRFE,0))[0 W !?5,"*Field: ",DDUCFE," (",DDUCXN,") triggers missing field ",DDUCRFE," in file ",DDUCRFI Q
14 I '$D(^DD(DDUCRFI,DDUCRFE,5)) D WHO,WFI,WFE W " 5 node is missing." I DDUCFIX S ^DD(DDUCRFI,DDUCRFE,5,1,0)=DDUC5 W !?10,"^DD(",DDUCRFI,",",DDUCRFE,",5,1,0) = ",DDUC5," was set." Q
15 Q:'DDUCFIX S (DDUCYY1,DDUCOK)=0
16 F DDUCYY=0:0 S DDUCYY=$O(^DD(DDUCRFI,DDUCRFE,5,DDUCYY)) Q:DDUCYY'>0 S DDUCYY1=DDUCYY,DDUCYYX=^(DDUCYY,0) I DDUCYYX=DDUC5 S DDUCOK=1 Q
17 I 'DDUCOK D WHO,WFI,WFE W " 5 node is missing." D:DDUCFIX TRIGM Q
18 Q
19TRIGM S ^DD(DDUCRFI,DDUCRFE,5,(DDUCYY1+1),0)=DDUC5
20 I DDUCRFI'=DDUCFE W !?10,"^DD(",DDUCRFI,",",DDUCRFE,",5,",DDUCYY1+1,",0) = ",DDUC5," was set."
21 Q
22COMP Q:DDUCX2'["C" S DDUCX=$S($D(^DD(DDUCFI,DDUCFE,9.01)):^(9.01),1:"")
23 F DDUCX1=1:1 Q:$P(DDUCX,";",DDUCX1)="" S DDUCRFI=+$P(DDUCX,";",DDUCX1),DDUCRFE=+$P($P(DDUCX,";",DDUCX1),U,2) I $D(^DD("ACOMP",DDUCRFI,DDUCRFE,DDUCFI,DDUCFE))[0 S:DDUCFIX ^DD("ACOMP",DDUCRFI,DDUCRFE,DDUCFI,DDUCFE)=""
24 Q
25WHO W !?8,"Field: ",DDUCFE," (",DDUCXN,") " Q
26WFI W !?8,"File: ",DDUCRFI," " Q
27WFE W ?8,"Field: ",DDUCRFE," " Q
28 ;
29DXREF ; Check for $Next usage; 22*130
30 ; DDUCFI = File #
31 ; DDUCFE = Field #
32 ; XRN = Cross Reference #
33 N XRN S XRN=0
34 F S XRN=$O(^DD(DDUCFI,DDUCFE,1,XRN)) Q:'XRN D
35 . ; XRN1 = Cross Reference Node Data
36 . N XRN1 S XRN1=""
37 . ; XRNW = 0 Have Not written warning, 1 have written warning
38 . N XRNW S XRNW=0
39 . F S XRN1=$O(^DD(DDUCFI,DDUCFE,1,XRN,XRN1)) Q:XRN1="" D
40 .. N GMSG S GMSG=0 ;1 equals use general message
41 .. I XRN1="%D" Q
42 .. I XRN1="DT" Q
43 .. ; Check for $Next any cross reference code
44 .. I ^DD(DDUCFI,DDUCFE,1,XRN,XRN1)["$N(",^DD(DDUCFI,DDUCFE,1,XRN,XRN1)'["$$N(" D I GMSG W !?5,"*Field: ",DDUCFE,", Cross Reference #: ",XRN,", Sub-Script: ",XRN1,", contains $Next."
45 ... I $P(^DD(DDUCFI,DDUCFE,1,XRN,0),U,3)'="TRIGGER" S GMSG=1 Q
46 ... ; Display/Fix known old FileMan TRIGGER Code:
47 ... ; "D ^DICR:$N(^DD(DIH,DIG,1,0))>0"
48 ... N DICRVAL
49 ... S DICRVAL=$G(^DD(DDUCFI,DDUCFE,1,XRN,XRN1))
50 ... I DICRVAL'["D ^DICR:$N(^DD(DIH,DIG,1,0))>0" S GMSG=1 Q
51 ... I 'XRNW D
52 .... W !?5,"*File: "_DDUCFI_", Field: "_DDUCFE_", XREF: "_XRN_" contains $Next in TRIGGER code."
53 .... S ^TMP("DDUCHK",$J,DDUCFI,DDUCFE,XRN)=""
54 .... S XRNW=1
55 Q
Note: See TracBrowser for help on using the repository browser.