DI222P26 ;OAKFO/RSD - Post Install for patch 26 ; Aug 01, 2023@13:13:01
;;22.2;VA FileMan;**26**;Jan 05, 2016;Build 1
;Per VA Directive 6402, this routine should not be modified.
;
EN ; clean up LANGUAGE File "D: cross reference
N C,X,Y,Z,DIK
S X(1)=" ** The post routine will check the LANGUAGE File (#.85) for corruption. **",X(2)=" "
D BMES^XPDUTL(.X)
;Kill current cross reference
K ^DI(.85,"D")
S DIK="^DI(.85,",DIK(1)=".03^D"
;re-index THREE LETTER CODE field (#.03)
D ENALL^DIK
;Check all entries for ALTERNATE THREE LETTER CODE field (#05)
S C=0 F S C=$O(^DI(.85,C)) Q:'C S Z=$G(^(C,0)),X=$P(Z,U,3),Y=$P(Z,U,5) D:Y]""
.;check for duplicate, if not set "D" cross ref as mnemonic
. I X'=Y S ^DI(.85,"D",Y,C)=1 Q
.;remove duplicate and save
. S $P(Z,U,5)="",^DI(.85,C,0)=Z
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDI222P26 829 printed Oct 16, 2024@18:45:02 Page 2
DI222P26 ;OAKFO/RSD - Post Install for patch 26 ; Aug 01, 2023@13:13:01
+1 ;;22.2;VA FileMan;**26**;Jan 05, 2016;Build 1
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
EN ; clean up LANGUAGE File "D: cross reference
+1 NEW C,X,Y,Z,DIK
+2 SET X(1)=" ** The post routine will check the LANGUAGE File (#.85) for corruption. **"
SET X(2)=" "
+3 DO BMES^XPDUTL(.X)
+4 ;Kill current cross reference
+5 KILL ^DI(.85,"D")
+6 SET DIK="^DI(.85,"
SET DIK(1)=".03^D"
+7 ;re-index THREE LETTER CODE field (#.03)
+8 DO ENALL^DIK
+9 ;Check all entries for ALTERNATE THREE LETTER CODE field (#05)
+10 SET C=0
FOR
SET C=$ORDER(^DI(.85,C))
if 'C
QUIT
SET Z=$GET(^(C,0))
SET X=$PIECE(Z,U,3)
SET Y=$PIECE(Z,U,5)
if Y]""
Begin DoDot:1
+11 ;check for duplicate, if not set "D" cross ref as mnemonic
+12 IF X'=Y
SET ^DI(.85,"D",Y,C)=1
QUIT
+13 ;remove duplicate and save
+14 SET $PIECE(Z,U,5)=""
SET ^DI(.85,C,0)=Z
+15 QUIT
End DoDot:1
+16 QUIT
