- DDUCHK3 ;SFISC/RWF-CHECK DD (XREF,COMPUTED) ;12:40 PM 4 Mar 2004
- ;;22.0;VA FileMan;**130**;Mar 30, 1999
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- 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
- Q
- 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
- I DDUCX["TRIGGER" S DDUCRFI=+$P(DDUCX,U,4),DDUCRFE=+$P(DDUCX,U,5),DDUC5=DDUCFI_U_DDUCFE_U_DDUCY D TRIG
- Q
- XREFM S ^DD(DDUCRFI,0,"IX",DDUCX1,DDUCFI,DDUCFE)="" W !?10,"^DD(",DDUCRFI,",0,""IX"",""",DDUCX1,""",",DDUCFI,",",DDUCFE,") = """" was set."
- Q
- TRIG I $D(^DD(DDUCRFI,0))[0 W !?5,"Field: ",DDUCFE," (",DDUCXN,") triggers missing file ",DDUCRFI Q
- I $D(^DD(DDUCRFI,DDUCRFE,0))[0 W !?5,"*Field: ",DDUCFE," (",DDUCXN,") triggers missing field ",DDUCRFE," in file ",DDUCRFI Q
- 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
- Q:'DDUCFIX S (DDUCYY1,DDUCOK)=0
- 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
- I 'DDUCOK D WHO,WFI,WFE W " 5 node is missing." D:DDUCFIX TRIGM Q
- Q
- TRIGM S ^DD(DDUCRFI,DDUCRFE,5,(DDUCYY1+1),0)=DDUC5
- I DDUCRFI'=DDUCFE W !?10,"^DD(",DDUCRFI,",",DDUCRFE,",5,",DDUCYY1+1,",0) = ",DDUC5," was set."
- Q
- COMP Q:DDUCX2'["C" S DDUCX=$S($D(^DD(DDUCFI,DDUCFE,9.01)):^(9.01),1:"")
- 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)=""
- Q
- WHO W !?8,"Field: ",DDUCFE," (",DDUCXN,") " Q
- WFI W !?8,"File: ",DDUCRFI," " Q
- WFE W ?8,"Field: ",DDUCRFE," " Q
- ;
- DXREF ; Check for $Next usage; 22*130
- ; DDUCFI = File #
- ; DDUCFE = Field #
- ; XRN = Cross Reference #
- N XRN S XRN=0
- F S XRN=$O(^DD(DDUCFI,DDUCFE,1,XRN)) Q:'XRN D
- . ; XRN1 = Cross Reference Node Data
- . N XRN1 S XRN1=""
- . ; XRNW = 0 Have Not written warning, 1 have written warning
- . N XRNW S XRNW=0
- . F S XRN1=$O(^DD(DDUCFI,DDUCFE,1,XRN,XRN1)) Q:XRN1="" D
- .. N GMSG S GMSG=0 ;1 equals use general message
- .. I XRN1="%D" Q
- .. I XRN1="DT" Q
- .. ; Check for $Next any cross reference code
- .. 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."
- ... I $P(^DD(DDUCFI,DDUCFE,1,XRN,0),U,3)'="TRIGGER" S GMSG=1 Q
- ... ; Display/Fix known old FileMan TRIGGER Code:
- ... ; "D ^DICR:$N(^DD(DIH,DIG,1,0))>0"
- ... N DICRVAL
- ... S DICRVAL=$G(^DD(DDUCFI,DDUCFE,1,XRN,XRN1))
- ... I DICRVAL'["D ^DICR:$N(^DD(DIH,DIG,1,0))>0" S GMSG=1 Q
- ... I 'XRNW D
- .... W !?5,"*File: "_DDUCFI_", Field: "_DDUCFE_", XREF: "_XRN_" contains $Next in TRIGGER code."
- .... S ^TMP("DDUCHK",$J,DDUCFI,DDUCFE,XRN)=""
- .... S XRNW=1
- Q
- DDUCHK3 ;SFISC/RWF-CHECK DD (XREF,COMPUTED) ;12:40 PM 4 Mar 2004
- +1 ;;22.0;VA FileMan;**130**;Mar 30, 1999
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- XREF FOR DDUCY=0:0
- SET DDUCY=$ORDER(^DD(DDUCFI,DDUCFE,1,DDUCY))
- IF DDUCY'>0
- QUIT
- SET DDUCX=^(DDUCY,0)
- SET DDUCRFI=+DDUCX
- SET DDUCX1=$PIECE(DDUCX,U,2)
- DO XREF1
- +1 QUIT
- XREF1 ;
- +1 IF DDUCRFI
- IF $DATA(^DD(DDUCRFI,0))
- IF $DATA(^DD(DDUCRFI,0,"IX",DDUCX1,DDUCFI,DDUCFE))[0
- DO WHO
- DO WFI
- WRITE "missing 'IX' node."
- IF DDUCFIX
- DO XREFM
- QUIT
- +2 IF DDUCX["TRIGGER"
- SET DDUCRFI=+$PIECE(DDUCX,U,4)
- SET DDUCRFE=+$PIECE(DDUCX,U,5)
- SET DDUC5=DDUCFI_U_DDUCFE_U_DDUCY
- DO TRIG
- +3 QUIT
- XREFM SET ^DD(DDUCRFI,0,"IX",DDUCX1,DDUCFI,DDUCFE)=""
- WRITE !?10,"^DD(",DDUCRFI,",0,""IX"",""",DDUCX1,""",",DDUCFI,",",DDUCFE,") = """" was set."
- +1 QUIT
- TRIG IF $DATA(^DD(DDUCRFI,0))[0
- WRITE !?5,"Field: ",DDUCFE," (",DDUCXN,") triggers missing file ",DDUCRFI
- QUIT
- +1 IF $DATA(^DD(DDUCRFI,DDUCRFE,0))[0
- WRITE !?5,"*Field: ",DDUCFE," (",DDUCXN,") triggers missing field ",DDUCRFE," in file ",DDUCRFI
- QUIT
- +2 IF '$DATA(^DD(DDUCRFI,DDUCRFE,5))
- DO WHO
- DO WFI
- DO WFE
- WRITE " 5 node is missing."
- IF DDUCFIX
- SET ^DD(DDUCRFI,DDUCRFE,5,1,0)=DDUC5
- WRITE !?10,"^DD(",DDUCRFI,",",DDUCRFE,",5,1,0) = ",DDUC5," was set."
- QUIT
- +3 IF 'DDUCFIX
- QUIT
- SET (DDUCYY1,DDUCOK)=0
- +4 FOR DDUCYY=0:0
- SET DDUCYY=$ORDER(^DD(DDUCRFI,DDUCRFE,5,DDUCYY))
- IF DDUCYY'>0
- QUIT
- SET DDUCYY1=DDUCYY
- SET DDUCYYX=^(DDUCYY,0)
- IF DDUCYYX=DDUC5
- SET DDUCOK=1
- QUIT
- +5 IF 'DDUCOK
- DO WHO
- DO WFI
- DO WFE
- WRITE " 5 node is missing."
- IF DDUCFIX
- DO TRIGM
- QUIT
- +6 QUIT
- TRIGM SET ^DD(DDUCRFI,DDUCRFE,5,(DDUCYY1+1),0)=DDUC5
- +1 IF DDUCRFI'=DDUCFE
- WRITE !?10,"^DD(",DDUCRFI,",",DDUCRFE,",5,",DDUCYY1+1,",0) = ",DDUC5," was set."
- +2 QUIT
- COMP IF DDUCX2'["C"
- QUIT
- SET DDUCX=$SELECT($DATA(^DD(DDUCFI,DDUCFE,9.01)):^(9.01),1:"")
- +1 FOR DDUCX1=1:1
- IF $PIECE(DDUCX,";",DDUCX1)=""
- QUIT
- SET DDUCRFI=+$PIECE(DDUCX,";",DDUCX1)
- SET DDUCRFE=+$PIECE($PIECE(DDUCX,";",DDUCX1),U,2)
- IF $DATA(^DD("ACOMP",DDUCRFI,DDUCRFE,DDUCFI,DDUCFE))[0
- IF DDUCFIX
- SET ^DD("ACOMP",DDUCRFI,DDUCRFE,DDUCFI,DDUCFE)=""
- +2 QUIT
- WHO WRITE !?8,"Field: ",DDUCFE," (",DDUCXN,") "
- QUIT
- WFI WRITE !?8,"File: ",DDUCRFI," "
- QUIT
- WFE WRITE ?8,"Field: ",DDUCRFE," "
- QUIT
- +1 ;
- DXREF ; Check for $Next usage; 22*130
- +1 ; DDUCFI = File #
- +2 ; DDUCFE = Field #
- +3 ; XRN = Cross Reference #
- +4 NEW XRN
- SET XRN=0
- +5 FOR
- SET XRN=$ORDER(^DD(DDUCFI,DDUCFE,1,XRN))
- IF 'XRN
- QUIT
- Begin DoDot:1
- +6 ; XRN1 = Cross Reference Node Data
- +7 NEW XRN1
- SET XRN1=""
- +8 ; XRNW = 0 Have Not written warning, 1 have written warning
- +9 NEW XRNW
- SET XRNW=0
- +10 FOR
- SET XRN1=$ORDER(^DD(DDUCFI,DDUCFE,1,XRN,XRN1))
- IF XRN1=""
- QUIT
- Begin DoDot:2
- +11 ;1 equals use general message
- NEW GMSG
- SET GMSG=0
- +12 IF XRN1="%D"
- QUIT
- +13 IF XRN1="DT"
- QUIT
- +14 ; Check for $Next any cross reference code
- +15 IF ^DD(DDUCFI,DDUCFE,1,XRN,XRN1)["$N("
- IF ^DD(DDUCFI,DDUCFE,1,XRN,XRN1)'["$$N("
- Begin DoDot:3
- +16 IF $PIECE(^DD(DDUCFI,DDUCFE,1,XRN,0),U,3)'="TRIGGER"
- SET GMSG=1
- QUIT
- +17 ; Display/Fix known old FileMan TRIGGER Code:
- +18 ; "D ^DICR:$N(^DD(DIH,DIG,1,0))>0"
- +19 NEW DICRVAL
- +20 SET DICRVAL=$GET(^DD(DDUCFI,DDUCFE,1,XRN,XRN1))
- +21 IF DICRVAL'["D ^DICR:$N(^DD(DIH,DIG,1,0))>0"
- SET GMSG=1
- QUIT
- +22 IF 'XRNW
- Begin DoDot:4
- +23 WRITE !?5,"*File: "_DDUCFI_", Field: "_DDUCFE_", XREF: "_XRN_" contains $Next in TRIGGER code."
- +24 SET ^TMP("DDUCHK",$JOB,DDUCFI,DDUCFE,XRN)=""
- +25 SET XRNW=1
- End DoDot:4
- End DoDot:3
- IF GMSG
- WRITE !?5,"*Field: ",DDUCFE,", Cross Reference #: ",XRN,", Sub-Script: ",XRN1,", contains $Next."
- End DoDot:2
- End DoDot:1
- +26 QUIT
