RA25PRE1.m

RA25PRE1 ;HOIFO/CRT - Pre-install routine for Rad patch 25

 ;;5.0;Radiology/Nuclear Medicine;**25**;Mar 16, 1998

 ;

 ; This routine will remove an existing option from menu

 ; because it will be added to a new menu later.

 ;

 ; Also changes Country Code to USA, from US for RA apps.

 ;

EN1 ;

 D MENU

 D USA

 Q

 ;

MENU N DA,DIK

 ;

 S DA(1)=$O(^DIC(19,"B","RA MAINTENANCEP",0)) Q:DA(1)=""

 S DA=$O(^DIC(19,"B","RA HL7 VOICE REPORTING ERRORS",0)) Q:DA=""

 ;

 S DA=$O(^DIC(19,DA(1),10,"B",DA,0)) Q:DA=""

 ;

 S DIK="^DIC(19,"_DA(1)_",10,"

 ;

 D EN^DDIOL("Removing 'Rad/Nuc Med HL7 Voice Reporting Errors'",,"!!?5")

 D EN^DDIOL("option from 'Maintenance Files Print Menu'...",,"!?5")

 ;

 D ^DIK

 Q

 ;

USA ; Change Country Code to USA

 ;

 N RAIENS,RAFDA,RAOUT,RACNTRY

 ;

 S RACNTRY=$O(^HL(779.004,"B","USA",0))

 Q:'RACNTRY

 ;

 F HL771="RA-TALK","RA-PSC","RA-VOICE" D 

 .S Y=HL771

 .F  S Y=$O(^HL(771,"B",Y)) Q:Y=""!(Y'[HL771)  D

 ..S RAIENS=$O(^HL(771,"B",Y,0))

 ..Q:RAIENS=""

 ..S RAIENS=RAIENS_","

 ..S RAFDA(771,RAIENS,7)=RACNTRY

 ..D FILE^DIE(,"RAFDA","RAOUT")

 ..I $G(RAFDA)'="" D  Q

 ...D EN^DDIOL("Failed to Update Country Code for Application '"_Y_"' to 'USA'",,"!?5")

 ..D EN^DDIOL("Updated Country Code for Application '"_Y_"' to 'USA'",,"!?5")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---RA25PRE1   1298     printed  Feb 18, 2025@23:59:26                                                                                                                                                                                                    Page 2

RA25PRE1  ;HOIFO/CRT - Pre-install routine for Rad patch 25

 +1       ;;5.0;Radiology/Nuclear Medicine;**25**;Mar 16, 1998

 +2       ;

 +3       ; This routine will remove an existing option from menu

 +4       ; because it will be added to a new menu later.

 +5       ;

 +6       ; Also changes Country Code to USA, from US for RA apps.

 +7       ;

EN1       ;

 +1        DO MENU

 +2        DO USA

 +3        QUIT 

 +4       ;

MENU       NEW DA,DIK

 +1       ;

 +2        SET DA(1)=$ORDER(^DIC(19,"B","RA MAINTENANCEP",0))

           if DA(1)=""

               QUIT 

 +3        SET DA=$ORDER(^DIC(19,"B","RA HL7 VOICE REPORTING ERRORS",0))

           if DA=""

               QUIT 

 +4       ;

 +5        SET DA=$ORDER(^DIC(19,DA(1),10,"B",DA,0))

           if DA=""

               QUIT 

 +6       ;

 +7        SET DIK="^DIC(19,"_DA(1)_",10,"

 +8       ;

 +9        DO EN^DDIOL("Removing 'Rad/Nuc Med HL7 Voice Reporting Errors'",,"!!?5")

 +10       DO EN^DDIOL("option from 'Maintenance Files Print Menu'...",,"!?5")

 +11      ;

 +12       DO ^DIK

 +13       QUIT 

 +14      ;

USA       ; Change Country Code to USA

 +1       ;

 +2        NEW RAIENS,RAFDA,RAOUT,RACNTRY

 +3       ;

 +4        SET RACNTRY=$ORDER(^HL(779.004,"B","USA",0))

 +5        if 'RACNTRY

               QUIT 

 +6       ;

 +7        FOR HL771="RA-TALK","RA-PSC","RA-VOICE"

               Begin DoDot:1

 +8                SET Y=HL771

 +9                FOR 

                       SET Y=$ORDER(^HL(771,"B",Y))

                       if Y=""!(Y'[HL771)

                           QUIT 

                       Begin DoDot:2

 +10                       SET RAIENS=$ORDER(^HL(771,"B",Y,0))

 +11                       if RAIENS=""

                               QUIT 

 +12                       SET RAIENS=RAIENS_","

 +13                       SET RAFDA(771,RAIENS,7)=RACNTRY

 +14                       DO FILE^DIE(,"RAFDA","RAOUT")

 +15                       IF $GET(RAFDA)'=""

                               Begin DoDot:3

 +16                               DO EN^DDIOL("Failed to Update Country Code for Application '"_Y_"' to 'USA'",,"!?5")

                               End DoDot:3

                               QUIT 

 +17                       DO EN^DDIOL("Updated Country Code for Application '"_Y_"' to 'USA'",,"!?5")

                       End DoDot:2

               End DoDot:1

 +18       QUIT