88 lines
4.6 KiB
Mathematica
88 lines
4.6 KiB
Mathematica
DDUCHK2 ;SFISC/RWF/SO-CHECK DD (FIELDS) ;11:46 AM 5 Mar 2004
|
|
;;22.0;VA FileMan;**100,130**;Mar 30, 1999
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
CHK6 ;W !?5,"Checking FIELDs"
|
|
F DDUCFE=0:0 S DDUCFE=+$O(^DD(DDUCFI,DDUCFE)) Q:DDUCFE'>0 D FIELD Q:$D(DIRUT) D FIVE,DXREF^DDUCHK3,XREF^DDUCHK3,COMP^DDUCHK3
|
|
;D CHKSB,CHKGL
|
|
Q
|
|
FIELD ;W "."
|
|
I $D(^DD(DDUCFI,DDUCFE,0))[0 W !?5,"*Field: ",DDUCFE," is missing its zero node." Q ;22*100,22*130
|
|
S DDUCX=^DD(DDUCFI,DDUCFE,0),DDUCX2=$P(DDUCX,U,2),DDUCX4=$P(DDUCX,U,4),DDUCXN=$P(DDUCX,U)
|
|
I $P(DDUCX,U,5,999)["$N(",$P(DDUCX,U,5,999)'["$$N(" W !?5,"*Field: ",DDUCFE,"'s Input Transform contains $Next."
|
|
;I DDUCX2["F",DDUCX4[";E1",$S($D(^DD(DDUCFI,DDUCFE,9)):^(9),1:"")'="@" D WHO W "doesn't have the correct protection for a field with executable code." I DDUCFIX S ^DD(DDUCFI,DDUCFE,9)="@" W !?10,"^DD(",DDUCFI,",",DDUCFE,",9) = ""@"" was set."
|
|
D @$S(+DDUCX2:"MULT",DDUCX2["P":"PT",DDUCX2["V":"VP",1:"Q") Q
|
|
Q
|
|
FIVE K DDUCXX F DDUCY=0:0 S DDUCY=$O(^DD(DDUCFI,DDUCFE,5,DDUCY)) Q:DDUCY'>0 S DDUCX=^(DDUCY,0) I $D(^DD(+DDUCX,+$P(DDUCX,U,2),1,+$P(DDUCX,U,3),0))#2 S DDUCXX(DDUCX)=""
|
|
Q:'DDUCFIX
|
|
K ^DD(DDUCFI,DDUCFE,5)
|
|
S DDUCX="" F DDUCY=1:1 S DDUCX=$O(DDUCXX(DDUCX)) Q:DDUCX="" S ^DD(DDUCFI,DDUCFE,5,DDUCY,0)=DDUCX
|
|
Q
|
|
VP F DDUCY=0:0 S DDUCY=$O(^DD(DDUCFI,DDUCFE,"V",DDUCY)) Q:DDUCY'>0 S DDUCRFI=$S($D(^DD(DDUCFI,DDUCFE,"V",DDUCY,0)):^(0),1:"") I DDUCRFI D PT1
|
|
Q
|
|
PT N DDUERR S DDUCRFI=+$P(DDUCX2,"P",2),DDUERR=0 D Q:DDUERR
|
|
. I $D(^DD(DDUCRFI,0))[0 W !?5,"*Field: ",DDUCFE," (",DDUCXN,") points to missing file: ",DDUCRFI S DDUERR=1 Q
|
|
. N DDUCGL,DDUCNA,DDUCHDR
|
|
. S DDUCGL=$G(^DIC(DDUCRFI,0,"GL"))
|
|
. I DDUCGL="" W !?5,"*Field: ",DDUCFE," (",DDUCXN,") points to File: "_DDUCRFI_", is missing file's ""GL"" (Global Location) node." S DDUERR=1 Q
|
|
. S DDUCHDR=DDUCGL_"0)",DDUCHDR=$G(@DDUCHDR)
|
|
. I DDUCHDR="" W !?5,"*Field: ",DDUCFE," (",DDUCXN,") points to File: "_DDUCRFI_", missing File header node." S DDUERR=1
|
|
. Q
|
|
PT1 I $D(^DD(+DDUCRFI,0,"PT",DDUCFI,DDUCFE))[0 D WHO W "is missing its 'PT' node in the pointed-to-file." I DDUCFIX S ^DD(+DDUCRFI,0,"PT",DDUCFI,DDUCFE)="" W !?10,"^DD(",+DDUCRFI,",0,""PT"",",DDUCFI,",",DDUCFE,") = """" was set."
|
|
Q Q ;QUIT TAG
|
|
MULT ;Work subfile
|
|
D PAGE^DDUCHK Q:$D(DIRUT)
|
|
I $D(^DD(+DDUCX2,0))[0 W !?5,"*Field: ",DDUCFE," (",DDUCXN,") missing subfile: ",+DDUCX2 Q
|
|
S DDUCUP=$S($D(^DD(+DDUCX2,0,"UP")):^("UP"),1:"") I DDUCUP'=DDUCFI D WHO W "Bad 'UP' pointer in subfile #",+DDUCX2 I DDUCFIX S ^DD(+DDUCX2,0,"UP")=DDUCFI W !?10,"^DD(",+DDUCX2,",0,""UP"") = ",DDUCFI," was set."
|
|
D PUSH S DDUCFI=+DDUCX2 W !?3,"Checking subfile ",DDUCFI D CHK^DDUCHK,POP W !?3,"Returning to ",$S('DDUCSTK:"main ",1:"sub"),"file",$S('DDUCSTK:" "_DDUCFILE_".",1:" "_DDUCFI)
|
|
Q
|
|
PUSH S DDUCSTK=DDUCSTK+1,DDUCSTK(DDUCSTK,1)=DDUCFI,DDUCSTK(DDUCSTK,2)=DDUCFE Q
|
|
POP S DDUCFI=DDUCSTK(DDUCSTK,1),DDUCFE=DDUCSTK(DDUCSTK,2),DDUCSTK=DDUCSTK-1 Q
|
|
WHO W !?8,"Field: ",DDUCFE," (",DDUCXN,") " Q
|
|
;
|
|
CHKSB ;Check for duplicate "SB" x-refs ;22*130
|
|
N DDUCSB
|
|
S DDUCSB=0
|
|
F S DDUCSB=+$O(^DD(DDUCFI,"SB",DDUCSB)) Q:'DDUCSB D
|
|
. N DDUCFE,DDUCSAV,DDUNFE
|
|
. S DDUCFE=0
|
|
. F S DDUCFE=+$O(^DD(DDUCFI,"SB",DDUCSB,DDUCFE)) Q:'DDUCFE D CHKSBA I '$D(DDUNFE),$O(^DD(DDUCFI,"SB",DDUCSB,DDUCFE)) D
|
|
.. N DDUCFE1,DDUCX
|
|
.. ;Is the TYPE "WP"?
|
|
.. S DDUCX=$O(^DD(DDUCFI,"SB",DDUCSB,DDUCFE)) I $D(^DD(DDUCFI,DDUCX,0)),$P(^DD(DDUCFI,DDUCX,0),U,4)["WP" Q
|
|
.. S DDUCSAV(DDUCFE)=""
|
|
.. S DDUCFE1=DDUCFE
|
|
.. F S DDUCFE1=+$O(^DD(DDUCFI,"SB",DDUCSB,DDUCFE1)) Q:'DDUCFE1 S DDUCSAV(DDUCFE1)=""
|
|
. N X1,X2
|
|
. S X1=0
|
|
. F S X1=$O(DDUCSAV(X1)) Q:'X1 D
|
|
.. I '$D(X2) W !?5,"*Duplicate Fields represent Sub-file: "_DDUCSB,!?7 S X2=1
|
|
.. W "field: "_X1_"; "
|
|
Q
|
|
;
|
|
CHKSBA ;Check if Feidl exists
|
|
I '$D(^DD(DDUCFI,DDUCFE,0))#2 W !?7,"*Field: "_DDUCFE_", File: "_DDUCFI_", ""SB"" subscript for subfile: "_DDUCSB_" is missing." S DDUNFE=1 Q
|
|
Q
|
|
;
|
|
CHKGL ;Check for duplicate "GL" nodes ;22*130
|
|
N DDUCN
|
|
S DDUCN=""
|
|
F S DDUCN=$O(^DD(DDUCFI,"GL",DDUCN)) Q:DDUCN="" D
|
|
. N DDUCP
|
|
. S DDUCP=0
|
|
. F S DDUCP=+$O(^DD(DDUCFI,"GL",DDUCN,DDUCP)) Q:'DDUCP D
|
|
.. N DDUCFE2,DDUCSAV
|
|
.. S DDUCFE2=0
|
|
.. F S DDUCFE2=+$O(^DD(DDUCFI,"GL",DDUCN,DDUCP,DDUCFE2)) Q:'DDUCFE2 I $O(^DD(DDUCFI,"GL",DDUCN,DDUCP,DDUCFE2)) D
|
|
... S DDUCSAV(DDUCN_";"_DDUCP,DDUCFE2)=""
|
|
... N X
|
|
... S X=0
|
|
... S X=$O(^DD(DDUCFI,"GL",DDUCN,DDUCP,DDUCFE2)) Q:'X S DDUCSAV(DDUCN_";"_DDUCP,X)=""
|
|
.. N X1,X2
|
|
.. S X1="" ;Global Location
|
|
.. F S X1=$O(DDUCSAV(X1)) Q:X1="" D
|
|
... I '$D(X2) W !?5,"*Duplication at global location subscript: "_$P(X1,";")_", piece: "_$P(X1,";",2),!?9 S X2=1
|
|
... N X3
|
|
... S X3=0 ;Field #
|
|
... F S X3=$O(DDUCSAV(X1,X3)) Q:'X3 W "field: "_X3_"; "
|
|
Q
|