File:  [Coherent Logic Development] / freem_fileman / USER / DDUCHK3.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:19 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

    1: DDUCHK3	;SFISC/RWF-CHECK DD (XREF,COMPUTED) ;2/1/91  3:39 PM
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: XREF	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
    6: XREF1	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
    7: 	I DDUCX["TRIGGER" S DDUCRFI=+$P(DDUCX,U,4),DDUCRFE=+$P(DDUCX,U,5),DDUC5=DDUCFI_U_DDUCFE_U_DDUCY D TRIG
    8: 	Q
    9: XREFM	S ^DD(DDUCRFI,0,"IX",DDUCX1,DDUCFI,DDUCFE)="" W !?10,"^DD(",DDUCRFI,",0,""IX"",""",DDUCX1,""",",DDUCFI,",",DDUCFE,") = """" was set."
   10: 	Q
   11: TRIG	I $D(^DD(DDUCRFI,0))[0 D WHO W "triggers missing file ",DDUCRFI Q
   12: 	I $D(^DD(DDUCRFI,DDUCRFE,0))[0 D WHO W "triggers missing field ",DDUCRFE," in file ",DDUCRFI Q
   13: 	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
   14: 	Q:'DDUCFIX  S (DDUCYY1,DDUCOK)=0
   15: 	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
   16: 	I 'DDUCOK D WHO,WFI,WFE W " 5 node is missing." D:DDUCFIX TRIGM Q
   17: 	Q
   18: TRIGM	S ^DD(DDUCRFI,DDUCRFE,5,(DDUCYY1+1),0)=DDUC5
   19: 	I DDUCRFI'=DDUCFE W !?10,"^DD(",DDUCRFI,",",DDUCRFE,",5,",DDUCYY1+1,",0) = ",DDUC5," was set."
   20: 	Q
   21: COMP	Q:DDUCX2'["C"  S DDUCX=$S($D(^DD(DDUCFI,DDUCFE,9.01)):^(9.01),1:"")
   22: 	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)=""
   23: 	Q
   24: WHO	W !?8,"Field: ",DDUCFE," (",DDUCXN,") " Q
   25: WFI	W !?8,"File: ",DDUCRFI," " Q
   26: WFE	W ?8,"Field: ",DDUCRFE," " Q

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>