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 ---[H[J[2J[HDIPR89 1460 printed Sep 23, 2025@20:29:30 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
