DIPR89.m

DIPR89 ;SFISC/SO-PRE INSTALL ROUTINE FOR PATCH DI*22.0*89 ;5:23 AM  2 Feb 2002

 ;;22.0;VA FileMan;**89**;Mar 30, 1999;Build 1

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 ;Utility to follow up patch DI*22*83

 ;Check for field whose type are Pointer and Set Of Codes

 ;whose $P#3 was has been corrupted and report them out for maual

 ;correction.

 ;Reference NOIS: BRX-1001-12770, Note #7 for replication and 'how

 ;to' manually correct.

 S X="Check for corrupted 3rd piece, Type: Pointer or Set Of Codes."

 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

 . . N NODE

 . . S NODE=$G(^DD(DDFILE,DDFIELD,0))

 . . I $P(NODE,U,3)]"" Q  ;No corruption here

 . . I $P(NODE,U,2)'["P",$P(NODE,U,2)'["S" Q  ;Something other than a Pointer or Set Of Codes Field

 . . ;Piece #3 of the DD node is Null & the field type is a Pointer or Set Of Codes

 . . I +$P(NODE,U,2) Q  ;We are looking at a Multiple

 . . S NOERR=1

 . . N X

 . . S X=">>File/Subfile: "_DDFILE

 . . D MES^XPDUTL(X)

 . . S X="  Field: #"_DDFIELD_"("_$P(NODE,U)_")  Type: "_$S($P(NODE,U,2)["P":"Pointer",$P(NODE,U,2)["S":"Set",1:"")

 . . 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 ---DIPR89   1460     printed  Mar 13, 2025@21:58:15                                                                                                                                                                                                      Page 2

DIPR89    ;SFISC/SO-PRE INSTALL ROUTINE FOR PATCH DI*22.0*89 ;5:23 AM  2 Feb 2002

 +1       ;;22.0;VA FileMan;**89**;Mar 30, 1999;Build 1

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;Utility to follow up patch DI*22*83

 +4       ;Check for field whose type are Pointer and Set Of Codes

 +5       ;whose $P#3 was has been corrupted and report them out for maual

 +6       ;correction.

 +7       ;Reference NOIS: BRX-1001-12770, Note #7 for replication and 'how

 +8       ;to' manually correct.

 +9        SET X="Check for corrupted 3rd piece, Type: Pointer or Set Of Codes."

 +10       DO MES^XPDUTL(X)

 +11       SET X="Checking..."

 +12       DO MES^XPDUTL(X)

 +13      ;

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                        NEW NODE

 +9                        SET NODE=$GET(^DD(DDFILE,DDFIELD,0))

 +10      ;No corruption here

                           IF $PIECE(NODE,U,3)]""

                               QUIT 

 +11      ;Something other than a Pointer or Set Of Codes Field

                           IF $PIECE(NODE,U,2)'["P"

                               IF $PIECE(NODE,U,2)'["S"

                                   QUIT 

 +12      ;Piece #3 of the DD node is Null & the field type is a Pointer or Set Of Codes

 +13      ;We are looking at a Multiple

                           IF +$PIECE(NODE,U,2)

                               QUIT 

 +14                       SET NOERR=1

 +15                       NEW X

 +16                       SET X=">>File/Subfile: "_DDFILE

 +17                       DO MES^XPDUTL(X)

 +18                       SET X="  Field: #"_DDFIELD_"("_$PIECE(NODE,U)_")  Type: "_$SELECT($PIECE(NODE,U,2)["P":"Pointer",$PIECE(NODE,U,2)["S":"Set",1:"")

 +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