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
;
;
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 ---[H[J[2J[HRA25PRE1 1298 printed Dec 13, 2024@02:33:10 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 ;
+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
