DI222P26.m

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 ---DI222P26   829     printed  Apr 09, 2024@21:54:40                                                                                                                                                                                                     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