| [613] | 1 | DDUCHK ;SFISC/RWF-CHECK DD ;11:25 AM 30 Dec 2004
|
|---|
| 2 | ;;22.0;VA FileMan;**130**;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ; DDUCFI=home file, DDUCFE=home field, DDUCFIX=flag to fix DD
|
|---|
| 5 | ; DDUCRFI=referenced file, DDUCRFE=referenced field.
|
|---|
| 6 | A W !!,"Check the Data Dictionary." D
|
|---|
| 7 | . W !,"Note: Messages that begin with an asterisk(*) can NOT be corrected and"
|
|---|
| 8 | . W !,"will need careful evaluation by software development!"
|
|---|
| 9 | S DDUC=""
|
|---|
| 10 | D DT^DICRW
|
|---|
| 11 | D L^DICRW1
|
|---|
| 12 | I X'>0 D G EXIT
|
|---|
| 13 | . I X'="" Q
|
|---|
| 14 | . W !?5,"*The file: "_$P($G(Y),U,2)_"(#"_$P($G(Y),U)_") is missing its ""GL"" (Global Location) node."
|
|---|
| 15 | . W !?6,"No further checking for this file can occur!"
|
|---|
| 16 | S DDUCFIS=+X-.000001,DDUCFIE=DIB(1)
|
|---|
| 17 | S DIR(0)="Y",DIR("A")="Remove erroneous nodes",DIR("B")="NO",DIR("?",1)="This routine will try to fix certain nodes that are erroneous and may set some nodes to a file referenced by the selected file."
|
|---|
| 18 | S DIR("?")="Say 'NO' here to leave the DD untouched. It will only flag the ones it finds erroneous."
|
|---|
| 19 | D ^DIR G EXIT:$D(DIRUT) S DDUCFIX=+Y K DIR
|
|---|
| 20 | ZIS S %ZIS="Q" D ^%ZIS G EXIT:POP
|
|---|
| 21 | I $D(IO("Q")) S ZTRTN="DQ^DDUCHK",ZTSAVE("DDUCFIX")="",ZTSAVE("DDUCFIS")="",ZTSAVE("DDUCFIE")="" D ^%ZTLOAD G EXIT
|
|---|
| 22 | DQ U IO K DDUCSTK,^TMP("DDUCHK",$J) S DDUCSTK=0,DDUCFX=DDUCFIX
|
|---|
| 23 | F DDUCFILE=DDUCFIS:0:DDUCFIE S DDUCFILE=$O(^DIC(DDUCFILE)) Q:DDUCFILE'>0!(DDUCFILE>DDUCFIE) D PAGE Q:$D(DIRUT) D
|
|---|
| 24 | . N DDUERR S DDUERR=0
|
|---|
| 25 | . W !!,"Checking file ",DDUCFILE
|
|---|
| 26 | . S (DDUCFI,DIFILE)=+DDUCFILE
|
|---|
| 27 | . D DDAC
|
|---|
| 28 | . D CHKHDR
|
|---|
| 29 | . I DDUERR Q
|
|---|
| 30 | . D CHK
|
|---|
| 31 | EXIT ;
|
|---|
| 32 | I $G(DUZ(0))="@",$D(^TMP("DDUCHK",$J)) D
|
|---|
| 33 | . W:$G(IOF)]"" @IOF
|
|---|
| 34 | . W !!,"List of ;;<file#>^<field #>^<cross reference#> that contain $Next"
|
|---|
| 35 | . N DDFIL S DDFIL=0 N I S I=1 N DDSP S DDSP=" "
|
|---|
| 36 | . F S DDFIL=$O(^TMP("DDUCHK",$J,DDFIL)) Q:'DDFIL D
|
|---|
| 37 | .. N DDFLD S DDFLD=0
|
|---|
| 38 | .. F S DDFLD=$O(^TMP("DDUCHK",$J,DDFIL,DDFLD)) Q:'DDFLD D
|
|---|
| 39 | ... N DDXRN S DDXRN=0
|
|---|
| 40 | ... F S DDXRN=$O(^TMP("DDUCHK",$J,DDFIL,DDFLD,DDXRN)) Q:'DDXRN D
|
|---|
| 41 | .... W !,I_$E(DDSP,1,(8-$L(I)))_";;"_DDFIL_U_DDFLD_U_DDXRN
|
|---|
| 42 | .... S I=I+1
|
|---|
| 43 | . S I=9999 W !,I_$E(DDSP,1,(8-$L(I)))_";;LAST LINE"
|
|---|
| 44 | K ^TMP("DDUCHK",$J)
|
|---|
| 45 | D ^%ZISC
|
|---|
| 46 | K DDUCFI,DDUCFIX,DDUCFILE,DDUCFIS,DDUCFIE,DDUCFE,DDUCX,DDUCX1,DDUCX2,DDUCX4,DDUCRFI
|
|---|
| 47 | K DDUCRFE,DDUCSTK,DDUCSTK,DDUCDNAM,DDUCNAME,DDUCXX,DDUCY,DDUCUP,DDUCXN
|
|---|
| 48 | K DDUCF,DDUCXREF,DDUCZ,DDUC5,DDUCYY,DDUCYY1,DDUCOK,DDUCYYX,DIB,DDUC,DDUCFX,DIAC,DIFILE
|
|---|
| 49 | Q
|
|---|
| 50 | ;
|
|---|
| 51 | PAGE I $Y+3>IOSL S DIR(0)="E" D:IOST["C-" ^DIR W @IOF
|
|---|
| 52 | Q
|
|---|
| 53 | ;
|
|---|
| 54 | DDAC I DUZ(0)'="@" S DIAC="DD" D ^DIAC S DDUCFIX=DDUCFX I 'DIAC,DDUCFX W !,"You don't have DD access to this file. No fixing will be done on this file." S DDUCFIX=0 Q
|
|---|
| 55 | Q
|
|---|
| 56 | CHK I $G(^DIC(DDUCFI,0))]"",'$P(^(0),U,2) S:DDUCFIX $P(^(0),U,2)=DDUCFI
|
|---|
| 57 | I $D(^DD(DDUCFI,0))[0 S DDUCRFI=DDUCFI W !?5,"*File: "_DDUCRFI_", is missing its file header node."
|
|---|
| 58 | I $D(^DD(DDUCFI,0,"ID")) D ID^DDUCHK1
|
|---|
| 59 | I $D(^DD(DDUCFI,0,"IX")) D IX^DDUCHK1
|
|---|
| 60 | I $D(^DD(DDUCFI,0,"PT")) D PT^DDUCHK1
|
|---|
| 61 | D CHKGL^DDUCHK2
|
|---|
| 62 | D CHKSB^DDUCHK2
|
|---|
| 63 | S DDUCNAME=$O(^DD(DDUCFI,0,"NM","")),DDUCDNAM=$O(^(DDUCNAME)),DDUCRFI=DDUCFI I DDUCDNAM]"" D WFI W "has duplicate 'NM' nodes." I DDUCFIX D NM^DDUCHK1
|
|---|
| 64 | I $D(^DD("ACOMP",DDUCFI)) D AC^DDUCHK1
|
|---|
| 65 | D INDEX^DDUCHK4(DDUCFI,DDUCFIX),KEY^DDUCHK5(DDUCFI,DDUCFIX)
|
|---|
| 66 | G ^DDUCHK2
|
|---|
| 67 | WFI W !?8,"File: ",DDUCRFI," " Q
|
|---|
| 68 | ;
|
|---|
| 69 | EN ;
|
|---|
| 70 | Q:'$D(DDUCFI)!'$D(DDUCFIX) S U="^"
|
|---|
| 71 | I DDUCFI Q:'$D(^DIC(DDUCFI,0,"GL")) G EN1
|
|---|
| 72 | Q:'$D(@(DDUCFI_"0)")) S DDUCFI=+$P(^(0),U,2)
|
|---|
| 73 | EN1 S DDUCFIS=+DDUCFI-.000001,DDUCFIE=+DDUCFI
|
|---|
| 74 | G ZIS
|
|---|
| 75 | ;
|
|---|
| 76 | CHKHDR ; Check for Missing or Incorrect File Header Node ;22*130
|
|---|
| 77 | ;W !?5,"File: ",DDUCFI," Checking File Header Node."
|
|---|
| 78 | N DDUCGL,DDUCNA,DDUCHDR
|
|---|
| 79 | S DDUCGL=$G(^DIC(DDUCFI,0,"GL"))
|
|---|
| 80 | I DDUCGL="" W !?5,"*File: "_DDUCFI_", is missing file's ""GL"" (Global Location) node.",!?6,"No further checking can occur!" S DDUERR=1 Q
|
|---|
| 81 | S DDUCHDR=DDUCGL_"0)",DDUCHDR=$G(@DDUCHDR)
|
|---|
| 82 | S DDUCNA=$P(^DIC(DDUCFI,0),U)
|
|---|
| 83 | I DDUCHDR="" W !?5,"*File: "_DDUCFI_", is missing the File header node." Q
|
|---|
| 84 | I $P(DDUCHDR,U)'=DDUCNA W !?5,"*File: "_DDUCFI_", header name is incorrect." Q
|
|---|
| 85 | I +$P(DDUCHDR,U,2)'=DDUCFI W !?5,"*File: "_DDUCFI_" File header number is incorrect." Q
|
|---|
| 86 | Q
|
|---|
