RAIPR229 ;HDSO/SCL - Pre-Install patch 229; Feb 27, 2026@14:27
;;5.0;Radiology/Nuclear Medicine;**229**;Mar 16, 1998;Build 4
;
; Reference to EN^DIU2 in ICR #10014
; Reference to MES^XPDUTL in ICR #10141
;
; code based on previous CPT patch routine ^RAIRP215 from 2024
;
PRE ;pre-install code to execute
;save pre-install version of file #73.2
N XTMP,DIU,RATXT,RAX,XTMPDT
S XTMP="RA229 PrePatch Save",XTMPDT=$$HTFM^XLFDT(+$H)
I $D(^XTMP(XTMP,0,XTMPDT)) D ;Already saved today do not resave
. S RATXT(1)=" "
. S RATXT(2)="Previous RADIOLOGY CPT BY PROCEDURE TYPE (file #73.2) backup is already on file."
. S RATXT(3)="Additional backup not performed"
. D MES^XPDUTL(.RATXT)
E D ; save backup before patch changes
. S ^XTMP(XTMP,0)=$$HTFM^XLFDT(+$H+184)_"^"_XTMPDT_"^RA(73.2) (File #73.2) backup prior to RA*5*229 patch update"
. S ^XTMP(XTMP,0,XTMPDT)="" ;Date saved
. M ^XTMP(XTMP,XTMPDT,"RA73.2")=^RA(73.2)
. S RATXT(1)=" "
. S RATXT(2)="A backup of RADIOLOGY CPT BY PROCEDURE TYPE (File #73.2)"
. S RATXT(3)="has been saved to ^XTMP("_XTMP_")."
. S RATXT(4)="The backup will be available for 6 months"
. D MES^XPDUTL(.RATXT)
K RATXT
;
; delete previous data from file #73.2
S DIU="^RA(73.2,",DIU(0)="DT" D EN^DIU2
S RAX=$O(^RA(73.2,0))
I $D(^RA(73.2,0))=0,(RAX="") D
.S RATXT(1)=" "
.S RATXT(2)="The RADIOLOGY CPT BY PROCEDURE TYPE (#73.2) has been deleted."
.S RATXT(3)="An updated version of file #73.2 will be installed."
.D MES^XPDUTL(.RATXT)
.Q
E D
.S RATXT(1)=" "
.S RATXT(2)="The RADIOLOGY CPT BY PROCEDURE TYPE (#73.2) has not been deleted."
.S RATXT(3)="An updated version of file #73.2 will not be installed."
.S RATXT(4)=" ",RATXT(5)="This build will not continue. Contact the national radiology"
.S RATXT(6)="development team."
.D MES^XPDUTL(.RATXT)
.;stop the build; keep the transport global
.S XPDQUIT=2
.Q
K DIU,RATXT,RAX,XTMP,XTMPDT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAIPR229 1955 printed Jul 22, 2026@15:43:50 Page 2
RAIPR229 ;HDSO/SCL - Pre-Install patch 229; Feb 27, 2026@14:27
+1 ;;5.0;Radiology/Nuclear Medicine;**229**;Mar 16, 1998;Build 4
+2 ;
+3 ; Reference to EN^DIU2 in ICR #10014
+4 ; Reference to MES^XPDUTL in ICR #10141
+5 ;
+6 ; code based on previous CPT patch routine ^RAIRP215 from 2024
+7 ;
PRE ;pre-install code to execute
+1 ;save pre-install version of file #73.2
+2 NEW XTMP,DIU,RATXT,RAX,XTMPDT
+3 SET XTMP="RA229 PrePatch Save"
SET XTMPDT=$$HTFM^XLFDT(+$HOROLOG)
+4 ;Already saved today do not resave
IF $DATA(^XTMP(XTMP,0,XTMPDT))
Begin DoDot:1
+5 SET RATXT(1)=" "
+6 SET RATXT(2)="Previous RADIOLOGY CPT BY PROCEDURE TYPE (file #73.2) backup is already on file."
+7 SET RATXT(3)="Additional backup not performed"
+8 DO MES^XPDUTL(.RATXT)
End DoDot:1
+9 ; save backup before patch changes
IF '$TEST
Begin DoDot:1
+10 SET ^XTMP(XTMP,0)=$$HTFM^XLFDT(+$HOROLOG+184)_"^"_XTMPDT_"^RA(73.2) (File #73.2) backup prior to RA*5*229 patch update"
+11 ;Date saved
SET ^XTMP(XTMP,0,XTMPDT)=""
+12 MERGE ^XTMP(XTMP,XTMPDT,"RA73.2")=^RA(73.2)
+13 SET RATXT(1)=" "
+14 SET RATXT(2)="A backup of RADIOLOGY CPT BY PROCEDURE TYPE (File #73.2)"
+15 SET RATXT(3)="has been saved to ^XTMP("_XTMP_")."
+16 SET RATXT(4)="The backup will be available for 6 months"
+17 DO MES^XPDUTL(.RATXT)
End DoDot:1
+18 KILL RATXT
+19 ;
+20 ; delete previous data from file #73.2
+21 SET DIU="^RA(73.2,"
SET DIU(0)="DT"
DO EN^DIU2
+22 SET RAX=$ORDER(^RA(73.2,0))
+23 IF $DATA(^RA(73.2,0))=0
IF (RAX="")
Begin DoDot:1
+24 SET RATXT(1)=" "
+25 SET RATXT(2)="The RADIOLOGY CPT BY PROCEDURE TYPE (#73.2) has been deleted."
+26 SET RATXT(3)="An updated version of file #73.2 will be installed."
+27 DO MES^XPDUTL(.RATXT)
+28 QUIT
End DoDot:1
+29 IF '$TEST
Begin DoDot:1
+30 SET RATXT(1)=" "
+31 SET RATXT(2)="The RADIOLOGY CPT BY PROCEDURE TYPE (#73.2) has not been deleted."
+32 SET RATXT(3)="An updated version of file #73.2 will not be installed."
+33 SET RATXT(4)=" "
SET RATXT(5)="This build will not continue. Contact the national radiology"
+34 SET RATXT(6)="development team."
+35 DO MES^XPDUTL(.RATXT)
+36 ;stop the build; keep the transport global
+37 SET XPDQUIT=2
+38 QUIT
End DoDot:1
+39 KILL DIU,RATXT,RAX,XTMP,XTMPDT
+40 QUIT
