DIPR103.m

DIPR103 ;SFISC/SO-PRE INSTALL ROUTINE FOR PATCH DI*22.0*103 ;1:18 PM  28 Feb 2002 [ 12/09/2003  3:15 PM ]

 ;;22.0;VA FileMan;**103,1002**;Mar 30, 1999

 ;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

DIPR103   ;SFISC/SO-PRE INSTALL ROUTINE FOR PATCH DI*22.0*103 ;1:18 PM  28 Feb 2002 [ 12/09/2003  3:15 PM ]

 +1       ;;22.0;VA FileMan;**103,1002**;Mar 30, 1999

 +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