XU8P137 ;SF/CIOFO-JDS Post Init for XU*8*137 ;02/18/2000 10:18
;KIDS POST-INIT
;
; This Post-Init routine cleans-up problem in the Patch
; Application History sub-file of the Package File and the
; State File.
;
EN D PATCH
D STATE
D MMXREF
Q
;
PATCH ;
; Search Patch Application History in the PACKAGE file
; for entries that contain version number_"*"_patch number_
; sequence number. The PAH field should only have
; patch number_sequence number for released patches.
; If a "*" is found it will be removed leaving patch and sequence
; numbers.
;
N X,Y,Z,PAHCOMM,PAHXX
W !,"Searching PACKAGE file to correct Patch Application History .."
F X=0:0 S X=$O(^DIC(9.4,X)) Q:X'>0 D
. W "."
. F Y=0:0 S Y=$O(^DIC(9.4,X,22,Y)) Q:Y'>0 D
. . W "."
. . F Z=0:0 S Z=$O(^DIC(9.4,X,22,Y,"PAH",Z)) Q:Z'>0 D
. . . S PAHCOMM=$P(^DIC(9.4,X,22,Y,"PAH",Z,0),"^",1)
. . . I PAHCOMM'["*" Q
. . . S PAHCOMM=$P(PAHCOMM,"*",2)
. . . K PAHXX
. . . S PAHXX(9.4901,Z_","_Y_","_X_",",.01)=PAHCOMM
. . . D FILE^DIE("","PAHXX")
. . . K PAHXX
. . . W "."
. . . Q
;
W !!,"Finished!"
Q
STATE ;
; This routine will remove the following corrupt DD nodes
; and Xref that reference Field #3 (COUNTY) of File #5 (STATE):
;
; 1. ^DD(5,"IX",3)
; 2. ^DD(5,0,"IX","D",5,3)
; 3. ^DD(5,3,1)
; 4. ^DIC(5,"D")
;
N ZZS0
S ZZS0=0
W !!,"Processing State File ..."
P1 ;
I $D(^DD(5,"IX",3))#2 D
. S ZZS0=1
. S X="Removing node: ^DD(5,""IX"",3)" D MES^XPDUTL(X)
. K ^DD(5,"IX",3) ;Uncomment when thru testing logic
;
P2 ;
I $D(^DD(5,0,"IX","D",5,3))#2 D
. S ZZS0=1
. S X="Removing node: ^DD(5,0,""IX"",""D"",5,3)" D MES^XPDUTL(X)
. K ^DD(5,0,"IX","D",5,3) ;Uncomment when thru testing logic
;
P3 ;
I $D(^DD(5,3,1,0))#2 D
. S ZZS0=1
. S X="Removing all Cross References on Field #3 (COUNTY)" D MES^XPDUTL(X)
. K ^DD(5,3,1) ;Uncomment when thru testing logic
;
P4 ;
I $D(^DIC(5,"D")) D
. S ZZS0=1
. S X="Removing the only reported ""Bad Cross Reference"" - ""D""" D MES^XPDUTL(X)
. K ^DIC(5,"D") ;Uncomment when thru testing logic
I 'ZZS0 S X="Everything is fine with Field #3 (COUNTY) of file #5 (STATE)." D MES^XPDUTL(X)
K ZZS0
Q
;
MMXREF ;
N DIK
S DIK="^VA(200,",DIK(1)="29^E"
D ENALL^DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXU8P137 2327 printed Apr 09, 2024@21:08:27 Page 2
XU8P137 ;SF/CIOFO-JDS Post Init for XU*8*137 ;02/18/2000 10:18
+1 ;KIDS POST-INIT
+2 ;
+3 ; This Post-Init routine cleans-up problem in the Patch
+4 ; Application History sub-file of the Package File and the
+5 ; State File.
+6 ;
EN DO PATCH
+1 DO STATE
+2 DO MMXREF
+3 QUIT
+4 ;
PATCH ;
+1 ; Search Patch Application History in the PACKAGE file
+2 ; for entries that contain version number_"*"_patch number_
+3 ; sequence number. The PAH field should only have
+4 ; patch number_sequence number for released patches.
+5 ; If a "*" is found it will be removed leaving patch and sequence
+6 ; numbers.
+7 ;
+8 NEW X,Y,Z,PAHCOMM,PAHXX
+9 WRITE !,"Searching PACKAGE file to correct Patch Application History .."
+10 FOR X=0:0
SET X=$ORDER(^DIC(9.4,X))
if X'>0
QUIT
Begin DoDot:1
+11 WRITE "."
+12 FOR Y=0:0
SET Y=$ORDER(^DIC(9.4,X,22,Y))
if Y'>0
QUIT
Begin DoDot:2
+13 WRITE "."
+14 FOR Z=0:0
SET Z=$ORDER(^DIC(9.4,X,22,Y,"PAH",Z))
if Z'>0
QUIT
Begin DoDot:3
+15 SET PAHCOMM=$PIECE(^DIC(9.4,X,22,Y,"PAH",Z,0),"^",1)
+16 IF PAHCOMM'["*"
QUIT
+17 SET PAHCOMM=$PIECE(PAHCOMM,"*",2)
+18 KILL PAHXX
+19 SET PAHXX(9.4901,Z_","_Y_","_X_",",.01)=PAHCOMM
+20 DO FILE^DIE("","PAHXX")
+21 KILL PAHXX
+22 WRITE "."
+23 QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+24 ;
+25 WRITE !!,"Finished!"
+26 QUIT
STATE ;
+1 ; This routine will remove the following corrupt DD nodes
+2 ; and Xref that reference Field #3 (COUNTY) of File #5 (STATE):
+3 ;
+4 ; 1. ^DD(5,"IX",3)
+5 ; 2. ^DD(5,0,"IX","D",5,3)
+6 ; 3. ^DD(5,3,1)
+7 ; 4. ^DIC(5,"D")
+8 ;
+9 NEW ZZS0
+10 SET ZZS0=0
+11 WRITE !!,"Processing State File ..."
P1 ;
+1 IF $DATA(^DD(5,"IX",3))#2
Begin DoDot:1
+2 SET ZZS0=1
+3 SET X="Removing node: ^DD(5,""IX"",3)"
DO MES^XPDUTL(X)
+4 ;Uncomment when thru testing logic
KILL ^DD(5,"IX",3)
End DoDot:1
+5 ;
P2 ;
+1 IF $DATA(^DD(5,0,"IX","D",5,3))#2
Begin DoDot:1
+2 SET ZZS0=1
+3 SET X="Removing node: ^DD(5,0,""IX"",""D"",5,3)"
DO MES^XPDUTL(X)
+4 ;Uncomment when thru testing logic
KILL ^DD(5,0,"IX","D",5,3)
End DoDot:1
+5 ;
P3 ;
+1 IF $DATA(^DD(5,3,1,0))#2
Begin DoDot:1
+2 SET ZZS0=1
+3 SET X="Removing all Cross References on Field #3 (COUNTY)"
DO MES^XPDUTL(X)
+4 ;Uncomment when thru testing logic
KILL ^DD(5,3,1)
End DoDot:1
+5 ;
P4 ;
+1 IF $DATA(^DIC(5,"D"))
Begin DoDot:1
+2 SET ZZS0=1
+3 SET X="Removing the only reported ""Bad Cross Reference"" - ""D"""
DO MES^XPDUTL(X)
+4 ;Uncomment when thru testing logic
KILL ^DIC(5,"D")
End DoDot:1
+5 IF 'ZZS0
SET X="Everything is fine with Field #3 (COUNTY) of file #5 (STATE)."
DO MES^XPDUTL(X)
+6 KILL ZZS0
+7 QUIT
+8 ;
MMXREF ;
+1 NEW DIK
+2 SET DIK="^VA(200,"
SET DIK(1)="29^E"
+3 DO ENALL^DIK
+4 QUIT
