DI14POST ;OAK/RSD Post Install for patch 14
;;22.2;VA FileMan;**14**;Jan 05, 2016;Build 8
;resave DIDT to %DT ICR #6212
N %D,%S,SCR,ZTOS
S SCR="I 1",%S="DIDT",%D="%DT",ZTOS=$$OSNUM^ZTMGRSET()
D MOVE^ZTMGRSET
;
;setup ^DD(.114 nodes, change 240 to 999
S ^DD(.114,6,0)="MAXIMUM LENGTH^NJ3,0^^0;5^K:+X'=X!(X>999)!(X<1)!(X?.E1"".""1N.N) X"
S ^DD(.114,6,3)="Answer must be between 1 and 999, with no decimal digits. Answer '??' for more help."
Q
;
EN ;find all sub data dictionaries and check zero node name
N DIR,I,J,K,X,Y
W !!,"This will check your account for bad ^DD(file #,0) nodes. It will look"
W !,"for multiples that don't have the field name as the 1st piece of the node."
W !,"It will display its results and ask you if you want to make the changes."
W !,"This will take 5 to 10 minutes."
I $G(^XTMP("DI14","C")) D
. W !!,"You already have bad nodes identified in the ^XTMP(""DI14"") global."
. W !,"If you proceed this data will be overwritten."
W !!,"Do you want to run the check?"
S DIR(0)="Y",DIR("B")="NO" D ^DIR
Q:'Y
K ^XTMP("DI14")
W !,".."
;reset expiration date to T+30 on transport global and "C"=count node
S ^XTMP("DI14",0)=$$FMADD^XLFDT(DT,30)_U_DT,^XTMP("DI14","C")=0,I=1
;if zero node contains 'FIELD', check if a file
F S I=$O(^DD(I)) Q:'I S J=$G(^DD(I,0)) I $P(J,U)="FIELD" D
. I $G(^DIC(I,0))]"",$G(^DIC(I,0,"GL"))]"" Q ;this is a file
. S K=$O(^DD(I,0,"NM","")) Q:K="" ;get subfield name
. S $P(J,U)=K_$S($G(^DD(I,0,"UP")):" SUB-FIELD",1:"") D REC("S","^DD("_I_",0)",J) ;set subfield name back on the zero node
. Q
S J=$G(^XTMP("DI14","C")) W !
I 'J W !,"No bad nodes",! Q
F I=1:1 S X=$G(^XTMP("DI14",I)) W !,$P(X,U,2) Q:I=J
W !!,J," bad node(s) found. Do you want to repair?"
S DIR(0)="Y",DIR("B")="NO" D ^DIR
Q:'Y
D EXEC W !!,"Done",!
Q
;
;
REC(X,Y,Z) ;record action X, global ref. Y, new value for set Z
;^XTMP("DI14",n)=action^global ref^new value
N C ;subscript counter
S C=^XTMP("DI14","C")+1,^("C")=C
I X="S" S ^XTMP("DI14",C)="S"_Y_"^"_$G(Z) Q
Q
;
EXEC ;execute the changes found
I '$G(^XTMP("DI14",0)) W !!,"Backup Global, ^XTMP(""DI14""), doesn't exists !!" Q
N I,X,Y
S I=0
F S I=$O(^XTMP("DI14",I)) Q:'I D
. S X=$G(^XTMP("DI14",I)),Y=$P(X,U,2)
. I $E(X)="S" S @("^"_Y)=$P(X,U,3,6) Q
. Q
Q
;
RESTORE ;restore the old values in ^XTMP("DI14")
I '$G(^XTMP("DI14",0)) W !!,"Backup Global, ^XTMP(""DI14""), doesn't exists !!" Q
N I,X,Y
S I=0
F S I=$O(^XTMP("DI14",I)) Q:'I D
. S X=$G(^XTMP("DI14",I)),Y=$P(X,U,2)
. ;restore old set value, 1st piece is always "FIELD"
. I $E(X)="S" S @("^"_Y)="FIELD^"_$P(X,U,4,6) Q
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDI14POST 2699 printed Dec 13, 2024@02:44:20 Page 2
DI14POST ;OAK/RSD Post Install for patch 14
+1 ;;22.2;VA FileMan;**14**;Jan 05, 2016;Build 8
+2 ;resave DIDT to %DT ICR #6212
+3 NEW %D,%S,SCR,ZTOS
+4 SET SCR="I 1"
SET %S="DIDT"
SET %D="%DT"
SET ZTOS=$$OSNUM^ZTMGRSET()
+5 DO MOVE^ZTMGRSET
+6 ;
+7 ;setup ^DD(.114 nodes, change 240 to 999
+8 SET ^DD(.114,6,0)="MAXIMUM LENGTH^NJ3,0^^0;5^K:+X'=X!(X>999)!(X<1)!(X?.E1"".""1N.N) X"
+9 SET ^DD(.114,6,3)="Answer must be between 1 and 999, with no decimal digits. Answer '??' for more help."
+10 QUIT
+11 ;
EN ;find all sub data dictionaries and check zero node name
+1 NEW DIR,I,J,K,X,Y
+2 WRITE !!,"This will check your account for bad ^DD(file #,0) nodes. It will look"
+3 WRITE !,"for multiples that don't have the field name as the 1st piece of the node."
+4 WRITE !,"It will display its results and ask you if you want to make the changes."
+5 WRITE !,"This will take 5 to 10 minutes."
+6 IF $GET(^XTMP("DI14","C"))
Begin DoDot:1
+7 WRITE !!,"You already have bad nodes identified in the ^XTMP(""DI14"") global."
+8 WRITE !,"If you proceed this data will be overwritten."
End DoDot:1
+9 WRITE !!,"Do you want to run the check?"
+10 SET DIR(0)="Y"
SET DIR("B")="NO"
DO ^DIR
+11 if 'Y
QUIT
+12 KILL ^XTMP("DI14")
+13 WRITE !,".."
+14 ;reset expiration date to T+30 on transport global and "C"=count node
+15 SET ^XTMP("DI14",0)=$$FMADD^XLFDT(DT,30)_U_DT
SET ^XTMP("DI14","C")=0
SET I=1
+16 ;if zero node contains 'FIELD', check if a file
+17 FOR
SET I=$ORDER(^DD(I))
if 'I
QUIT
SET J=$GET(^DD(I,0))
IF $PIECE(J,U)="FIELD"
Begin DoDot:1
+18 ;this is a file
IF $GET(^DIC(I,0))]""
IF $GET(^DIC(I,0,"GL"))]""
QUIT
+19 ;get subfield name
SET K=$ORDER(^DD(I,0,"NM",""))
if K=""
QUIT
+20 ;set subfield name back on the zero node
SET $PIECE(J,U)=K_$SELECT($GET(^DD(I,0,"UP")):" SUB-FIELD",1:"")
DO REC("S","^DD("_I_",0)",J)
+21 QUIT
End DoDot:1
+22 SET J=$GET(^XTMP("DI14","C"))
WRITE !
+23 IF 'J
WRITE !,"No bad nodes",!
QUIT
+24 FOR I=1:1
SET X=$GET(^XTMP("DI14",I))
WRITE !,$PIECE(X,U,2)
if I=J
QUIT
+25 WRITE !!,J," bad node(s) found. Do you want to repair?"
+26 SET DIR(0)="Y"
SET DIR("B")="NO"
DO ^DIR
+27 if 'Y
QUIT
+28 DO EXEC
WRITE !!,"Done",!
+29 QUIT
+30 ;
+31 ;
REC(X,Y,Z) ;record action X, global ref. Y, new value for set Z
+1 ;^XTMP("DI14",n)=action^global ref^new value
+2 ;subscript counter
NEW C
+3 SET C=^XTMP("DI14","C")+1
SET ^("C")=C
+4 IF X="S"
SET ^XTMP("DI14",C)="S"_Y_"^"_$GET(Z)
QUIT
+5 QUIT
+6 ;
EXEC ;execute the changes found
+1 IF '$GET(^XTMP("DI14",0))
WRITE !!,"Backup Global, ^XTMP(""DI14""), doesn't exists !!"
QUIT
+2 NEW I,X,Y
+3 SET I=0
+4 FOR
SET I=$ORDER(^XTMP("DI14",I))
if 'I
QUIT
Begin DoDot:1
+5 SET X=$GET(^XTMP("DI14",I))
SET Y=$PIECE(X,U,2)
+6 IF $EXTRACT(X)="S"
SET @("^"_Y)=$PIECE(X,U,3,6)
QUIT
+7 QUIT
End DoDot:1
+8 QUIT
+9 ;
RESTORE ;restore the old values in ^XTMP("DI14")
+1 IF '$GET(^XTMP("DI14",0))
WRITE !!,"Backup Global, ^XTMP(""DI14""), doesn't exists !!"
QUIT
+2 NEW I,X,Y
+3 SET I=0
+4 FOR
SET I=$ORDER(^XTMP("DI14",I))
if 'I
QUIT
Begin DoDot:1
+5 SET X=$GET(^XTMP("DI14",I))
SET Y=$PIECE(X,U,2)
+6 ;restore old set value, 1st piece is always "FIELD"
+7 IF $EXTRACT(X)="S"
SET @("^"_Y)="FIELD^"_$PIECE(X,U,4,6)
QUIT
+8 QUIT
End DoDot:1
+9 QUIT
