DIPR103 ;SFISC/SO-PRE INSTALL ROUTINE FOR PATCH DI*22.0*103 ;1:18 PM 28 Feb 2002
;;22.0;VA FileMan;**103**;Mar 30, 1999;Build 1
;Per VHA Directive 10-93-142, this routine should not be modified.
;Check for field whose type are WP and missing the 'W'
;whose $P#2 was has been corrupted and report them out for maunal
;correction.
S X="Check for corrupted Type: Word Processing."
D MES^XPDUTL(X)
S X="Checking..."
D MES^XPDUTL(X)
;
S ; Start testing
N DDFILE,NOERR
S NOERR=0
S DDFILE=1.99999
F S DDFILE=$O(^DD(DDFILE)) Q:'DDFILE D
. N DDFIELD
. S DDFIELD=0
. F S DDFIELD=$O(^DD(DDFILE,DDFIELD)) Q:'DDFIELD D
. . I '$D(^DD(DDFILE,0,"UP")) Q ;Not a sub-file
. . I DDFIELD'=.01 Q ;Not a field we are interested in
. . N NODE
. . S NODE=$G(^DD(DDFILE,DDFIELD,0))
. . I $P(NODE,U,2)]"" Q ;No corruption here
. . ;Piece #2 of the DD node is Null
. . S NOERR=1
. . N X
. . S X=">>Subfile: "_DDFILE
. . D MES^XPDUTL(X)
. . S X=" Field: #"_DDFIELD_"("_$P(NODE,U)_")"
. . D MES^XPDUTL(X)
. . S X=" Node="_NODE
. . D MES^XPDUTL(X)
I 'NOERR S X="No problems found" D MES^XPDUTL(X)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIPR103 1147 printed Dec 13, 2024@02:53:09 Page 2
DIPR103 ;SFISC/SO-PRE INSTALL ROUTINE FOR PATCH DI*22.0*103 ;1:18 PM 28 Feb 2002
+1 ;;22.0;VA FileMan;**103**;Mar 30, 1999;Build 1
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;Check for field whose type are WP and missing the 'W'
+4 ;whose $P#2 was has been corrupted and report them out for maunal
+5 ;correction.
+6 SET X="Check for corrupted Type: Word Processing."
+7 DO MES^XPDUTL(X)
+8 SET X="Checking..."
+9 DO MES^XPDUTL(X)
+10 ;
S ; Start testing
+1 NEW DDFILE,NOERR
+2 SET NOERR=0
+3 SET DDFILE=1.99999
+4 FOR
SET DDFILE=$ORDER(^DD(DDFILE))
if 'DDFILE
QUIT
Begin DoDot:1
+5 NEW DDFIELD
+6 SET DDFIELD=0
+7 FOR
SET DDFIELD=$ORDER(^DD(DDFILE,DDFIELD))
if 'DDFIELD
QUIT
Begin DoDot:2
+8 ;Not a sub-file
IF '$DATA(^DD(DDFILE,0,"UP"))
QUIT
+9 ;Not a field we are interested in
IF DDFIELD'=.01
QUIT
+10 NEW NODE
+11 SET NODE=$GET(^DD(DDFILE,DDFIELD,0))
+12 ;No corruption here
IF $PIECE(NODE,U,2)]""
QUIT
+13 ;Piece #2 of the DD node is Null
+14 SET NOERR=1
+15 NEW X
+16 SET X=">>Subfile: "_DDFILE
+17 DO MES^XPDUTL(X)
+18 SET X=" Field: #"_DDFIELD_"("_$PIECE(NODE,U)_")"
+19 DO MES^XPDUTL(X)
+20 SET X=" Node="_NODE
+21 DO MES^XPDUTL(X)
End DoDot:2
End DoDot:1
+22 IF 'NOERR
SET X="No problems found"
DO MES^XPDUTL(X)
+23 QUIT
