RAIPS226 ;WOIFO/KLM - Post-init Driver, patch 226 ; Oct 08, 2025@10:00
;;5.0;Radiology/Nuclear Medicine;**226**;Mar 16, 1998;Build 2
;
;This patch will add the new Oracle/Cerner standard procedures to the radiology package
;and sync them with CPRS. They will be deployed inactive.
;
;The new procedures are being passed in with the NEW RAD PROCEDURE WORKUP file (#71.11)
;
Q
;
EN1 ;Main entry point (Called from KIDS)
N RA01,RAERR,RASAV,RAY,RATMPDA,RAIENS,RADA,RAFDA,RA71Z,IENS,RAPROCT,RAR
S RAPROCT=0 ;counter
K ^XTMP("RA226_ERRORS")
S ^XTMP("RA226_ERRORS",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"RA*5*226 Errors filing procedure data"
S RATMPDA=0 F S RATMPDA=$O(^RAMRPF(71.11,RATMPDA)) Q:RATMPDA="" D
.S RA01=$P($G(^RAMRPF(71.11,RATMPDA,0)),U) Q:RA01=""
.;Create .01 first
.N RAFDA,RAR S RAR="RAFDA(71,""?+1,"")" ;FDA root -check for existing entry
.S @RAR@(.01)=RA01 ;Name
.K RAERR,RAIENS,RADA
.D UPDATE^DIE(,"RAFDA","RADA","RAERR") K RAFDA
.I $D(RAERR(1,"DIERR"))#2 S ^XTMP("RA226_ERRORS","DIERR",RA01)="An error occured filing data for "_RA01 Q
.;
.;Update rest of fields (ZERO node)
.Q:'$D(RADA)
.I $G(RADA(1,0))'="+" S ^XTMP("RA226_ERRORS","DIERR",RA01)="Error Filing Data - procedure already exists. "_RA01 Q
.S RASAV=RADA(1),RAIENS=RADA(1)_","
.S IENS=RATMPDA_"," ;71.11 IENS
.D GETS^DIQ(71.11,IENS,"6;7;9;11;12;17;20","E","RA71Z","RAERR")
.K RAFDA,RAERR,RAR
.S RAR="RAFDA(71,RAIENS)"
.S @RAR@(6)=$G(RA71Z(71.11,IENS,6,"E")) ;Type of Procedure
.S @RAR@(7)=$G(RA71Z(71.11,IENS,7,"E")) ;Staff Review Required
.S @RAR@(8)="Y" ;Standard Procedure (no editing)
.S @RAR@(9)=$G(RA71Z(71.11,IENS,9,"E")) ;CPT Code
.S @RAR@(11)=$G(RA71Z(71.11,IENS,11,"E")) ;Rad/NM Phys Approval required
.S @RAR@(12)=$G(RA71Z(71.11,IENS,12,"E")) ;Type of Imaging
.S @RAR@(17)=$G(RA71Z(71.11,IENS,17,"E")) ;Display ED DESC when ordered
.S @RAR@(20)=$G(RA71Z(71.11,IENS,20,"E")) ;Contrast Media Used?
.S @RAR@(100)=$$FMADD^XLFDT(DT,-1) ;Inactive Date (t-1)
.K RAERR D FILE^DIE("E","RAFDA","RAERR")
.I $D(RAERR(1,"DIERR"))#2 S ^XTMP("RA226_ERRORS","DIERR",RA01)="An error occured filing data for "_RA01
.;
.;Contrast Media - Mult field #125
.I $$GET1^DIQ(71,RASAV,20)="Yes" D
..N RA125
..S RA125=$G(^RAMRPF(71.11,RATMPDA,"CM",1,0)) Q:RA125=""
..K RAFDA,RAERR,RAIENS
..S RAIENS="+1,"_RASAV_","
..S RAFDA(71.0125,RAIENS,.01)=$G(RA125)
..D UPDATE^DIE("","RAFDA","RAIENS","RAERR")
..I $D(RAERR(1,"DIERR"))#2 S ^XTMP("RA226_ERRORS","DIERR",RA01)="Error filing contrast media data"
..D FILEAU^RAMAINU1(RASAV,RA125) ;update the activity log
..Q
.;
.;Modality - Mult field #731
.N RA731
.S RA731=$$GET1^DIQ(71.11731,1_","_RATMPDA_",",.01)
.K RAFDA,RAERR,RAIENS
.S RAIENS="+1,"_RASAV_","
.S RAFDA(71.0731,RAIENS,.01)=$G(RA731)
.D UPDATE^DIE("E","RAFDA","RAIENS","RAERR")
.I $D(RAERR(1,"DIERR"))#2 S ^XTMP("RA226_ERRORS","DIERR",RA01)="Error filing modality data."
.;
.;Educational Description - WP field #500
.N RAEDU,RA500,I
.S RAEDU=$$GET1^DIQ(71.11,RATMPDA_",",500,"","RA500")
.K RAFDA,RAERR,RAIENS,^TMP($J,"RA226")
.S RAIENS=RASAV_","
.S I=0 F S I=$O(RA500(I)) Q:I="" S ^TMP($J,"RA226",I,0)=$G(RA500(I))
.D WP^DIE(71,RAIENS,500,"","^TMP($J,""RA226"")","RAERR")
.I $D(RAERR(1,"DIERR"))#2 S ^XTMP("RA226_ERRORS","DIERR",RA01)="Error filing the educational description"
.;
.;Orderable Item update (#101.43)
.S RAY=RASAV_"^"_RA01_"^"_1 ;for OI update
.N RAENALL,RAFILE,RASTAT
.S RAENALL=0,RAFILE=71,RASTAT=1,RAY=RASAV_"^"_RA01_"^"_1
.D PROC^RAO7MFN(RAENALL,RAFILE,RASTAT,RAY)
.;
.S RAPROCT=RAPROCT+1
.Q
D EN2^RAIPS226(RAPROCT)
D EN3^RAIPS226
Q
EN2(RACNT) ;Mailman message
N XMDUZ,XMSUB,XMTEXT,XMY,RAC3,RAXT,RATEXT,RATXCNT,RA01,RAEMSG,RAMDUZ
N DIFROM ;Required for mailman API (per Kernel DG)
I '$D(^XTMP("RA226_ERRORS","DIERR")) S RATEXT(6)="*** No procedure filing errors ***"
S RAXT=$NA(^XTMP("RA226_ERRORS"))
;Mail message introductory blurb...
S RATEXT(1)="The post-init routine RAIPS226 has completed the installation of patch "
S RATEXT(2)="RA*5.0*226, adding the national standard radiology procedure order set."
S RATEXT(3)=""
S RATEXT(4)="The number of procedures added: "_RACNT
S RATEXT(5)=""
I $D(^XTMP("RA226_ERRORS","DIERR")) D
.S RATEXT(6)="There were errors filing the procedure data, contact the radiology developers."
.S RATEXT(7)=""
.S RATEXT(8)="Error messages are stored in "_RAXT
.S RATEXT(9)=""
.S RA01="" F RATXCNT=10:1 S RA01=$O(^XTMP("RA226_ERRORS","DIERR",RA01)) Q:RA01="" D
..S RAEMSG=^XTMP("RA226_ERRORS","DIERR",RA01)
..S RATEXT(RATXCNT)=RAEMSG_$S(RAEMSG[RA01:"",1:" for "_RA01)
.Q
;XMTEXT for message text
S XMTEXT="RATEXT("
S XMSUB="RA*5.0*226 - Post-Init Results"
S XMDUZ=.5 ;postmaster
;Mail Recipients
S XMY(DUZ)=""
S RAMDUZ=.5 F S RAMDUZ=$O(^XUSEC("RA MGR",RAMDUZ)) Q:RAMDUZ="" S XMY(RAMDUZ)=""
D ^XMD
Q
EN3 ;Clean-up the NEW RAD PROCEDURE WORKUP file (#71.11)
N RADA,DA
S RADA=0 F S RADA=$O(^RAMRPF(71.11,RADA)) Q:RADA="" D
.S DIK="^RAMRPF(71.11,",DA=RADA D ^DIK
.K DIK,DA
.Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAIPS226 5129 printed Mar 25, 2026@16:01:02 Page 2
RAIPS226 ;WOIFO/KLM - Post-init Driver, patch 226 ; Oct 08, 2025@10:00
+1 ;;5.0;Radiology/Nuclear Medicine;**226**;Mar 16, 1998;Build 2
+2 ;
+3 ;This patch will add the new Oracle/Cerner standard procedures to the radiology package
+4 ;and sync them with CPRS. They will be deployed inactive.
+5 ;
+6 ;The new procedures are being passed in with the NEW RAD PROCEDURE WORKUP file (#71.11)
+7 ;
+8 QUIT
+9 ;
EN1 ;Main entry point (Called from KIDS)
+1 NEW RA01,RAERR,RASAV,RAY,RATMPDA,RAIENS,RADA,RAFDA,RA71Z,IENS,RAPROCT,RAR
+2 ;counter
SET RAPROCT=0
+3 KILL ^XTMP("RA226_ERRORS")
+4 SET ^XTMP("RA226_ERRORS",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"RA*5*226 Errors filing procedure data"
+5 SET RATMPDA=0
FOR
SET RATMPDA=$ORDER(^RAMRPF(71.11,RATMPDA))
if RATMPDA=""
QUIT
Begin DoDot:1
+6 SET RA01=$PIECE($GET(^RAMRPF(71.11,RATMPDA,0)),U)
if RA01=""
QUIT
+7 ;Create .01 first
+8 ;FDA root -check for existing entry
NEW RAFDA,RAR
SET RAR="RAFDA(71,""?+1,"")"
+9 ;Name
SET @RAR@(.01)=RA01
+10 KILL RAERR,RAIENS,RADA
+11 DO UPDATE^DIE(,"RAFDA","RADA","RAERR")
KILL RAFDA
+12 IF $DATA(RAERR(1,"DIERR"))#2
SET ^XTMP("RA226_ERRORS","DIERR",RA01)="An error occured filing data for "_RA01
QUIT
+13 ;
+14 ;Update rest of fields (ZERO node)
+15 if '$DATA(RADA)
QUIT
+16 IF $GET(RADA(1,0))'="+"
SET ^XTMP("RA226_ERRORS","DIERR",RA01)="Error Filing Data - procedure already exists. "_RA01
QUIT
+17 SET RASAV=RADA(1)
SET RAIENS=RADA(1)_","
+18 ;71.11 IENS
SET IENS=RATMPDA_","
+19 DO GETS^DIQ(71.11,IENS,"6;7;9;11;12;17;20","E","RA71Z","RAERR")
+20 KILL RAFDA,RAERR,RAR
+21 SET RAR="RAFDA(71,RAIENS)"
+22 ;Type of Procedure
SET @RAR@(6)=$GET(RA71Z(71.11,IENS,6,"E"))
+23 ;Staff Review Required
SET @RAR@(7)=$GET(RA71Z(71.11,IENS,7,"E"))
+24 ;Standard Procedure (no editing)
SET @RAR@(8)="Y"
+25 ;CPT Code
SET @RAR@(9)=$GET(RA71Z(71.11,IENS,9,"E"))
+26 ;Rad/NM Phys Approval required
SET @RAR@(11)=$GET(RA71Z(71.11,IENS,11,"E"))
+27 ;Type of Imaging
SET @RAR@(12)=$GET(RA71Z(71.11,IENS,12,"E"))
+28 ;Display ED DESC when ordered
SET @RAR@(17)=$GET(RA71Z(71.11,IENS,17,"E"))
+29 ;Contrast Media Used?
SET @RAR@(20)=$GET(RA71Z(71.11,IENS,20,"E"))
+30 ;Inactive Date (t-1)
SET @RAR@(100)=$$FMADD^XLFDT(DT,-1)
+31 KILL RAERR
DO FILE^DIE("E","RAFDA","RAERR")
+32 IF $DATA(RAERR(1,"DIERR"))#2
SET ^XTMP("RA226_ERRORS","DIERR",RA01)="An error occured filing data for "_RA01
+33 ;
+34 ;Contrast Media - Mult field #125
+35 IF $$GET1^DIQ(71,RASAV,20)="Yes"
Begin DoDot:2
+36 NEW RA125
+37 SET RA125=$GET(^RAMRPF(71.11,RATMPDA,"CM",1,0))
if RA125=""
QUIT
+38 KILL RAFDA,RAERR,RAIENS
+39 SET RAIENS="+1,"_RASAV_","
+40 SET RAFDA(71.0125,RAIENS,.01)=$GET(RA125)
+41 DO UPDATE^DIE("","RAFDA","RAIENS","RAERR")
+42 IF $DATA(RAERR(1,"DIERR"))#2
SET ^XTMP("RA226_ERRORS","DIERR",RA01)="Error filing contrast media data"
+43 ;update the activity log
DO FILEAU^RAMAINU1(RASAV,RA125)
+44 QUIT
End DoDot:2
+45 ;
+46 ;Modality - Mult field #731
+47 NEW RA731
+48 SET RA731=$$GET1^DIQ(71.11731,1_","_RATMPDA_",",.01)
+49 KILL RAFDA,RAERR,RAIENS
+50 SET RAIENS="+1,"_RASAV_","
+51 SET RAFDA(71.0731,RAIENS,.01)=$GET(RA731)
+52 DO UPDATE^DIE("E","RAFDA","RAIENS","RAERR")
+53 IF $DATA(RAERR(1,"DIERR"))#2
SET ^XTMP("RA226_ERRORS","DIERR",RA01)="Error filing modality data."
+54 ;
+55 ;Educational Description - WP field #500
+56 NEW RAEDU,RA500,I
+57 SET RAEDU=$$GET1^DIQ(71.11,RATMPDA_",",500,"","RA500")
+58 KILL RAFDA,RAERR,RAIENS,^TMP($JOB,"RA226")
+59 SET RAIENS=RASAV_","
+60 SET I=0
FOR
SET I=$ORDER(RA500(I))
if I=""
QUIT
SET ^TMP($JOB,"RA226",I,0)=$GET(RA500(I))
+61 DO WP^DIE(71,RAIENS,500,"","^TMP($J,""RA226"")","RAERR")
+62 IF $DATA(RAERR(1,"DIERR"))#2
SET ^XTMP("RA226_ERRORS","DIERR",RA01)="Error filing the educational description"
+63 ;
+64 ;Orderable Item update (#101.43)
+65 ;for OI update
SET RAY=RASAV_"^"_RA01_"^"_1
+66 NEW RAENALL,RAFILE,RASTAT
+67 SET RAENALL=0
SET RAFILE=71
SET RASTAT=1
SET RAY=RASAV_"^"_RA01_"^"_1
+68 DO PROC^RAO7MFN(RAENALL,RAFILE,RASTAT,RAY)
+69 ;
+70 SET RAPROCT=RAPROCT+1
+71 QUIT
End DoDot:1
+72 DO EN2^RAIPS226(RAPROCT)
+73 DO EN3^RAIPS226
+74 QUIT
EN2(RACNT) ;Mailman message
+1 NEW XMDUZ,XMSUB,XMTEXT,XMY,RAC3,RAXT,RATEXT,RATXCNT,RA01,RAEMSG,RAMDUZ
+2 ;Required for mailman API (per Kernel DG)
NEW DIFROM
+3 IF '$DATA(^XTMP("RA226_ERRORS","DIERR"))
SET RATEXT(6)="*** No procedure filing errors ***"
+4 SET RAXT=$NAME(^XTMP("RA226_ERRORS"))
+5 ;Mail message introductory blurb...
+6 SET RATEXT(1)="The post-init routine RAIPS226 has completed the installation of patch "
+7 SET RATEXT(2)="RA*5.0*226, adding the national standard radiology procedure order set."
+8 SET RATEXT(3)=""
+9 SET RATEXT(4)="The number of procedures added: "_RACNT
+10 SET RATEXT(5)=""
+11 IF $DATA(^XTMP("RA226_ERRORS","DIERR"))
Begin DoDot:1
+12 SET RATEXT(6)="There were errors filing the procedure data, contact the radiology developers."
+13 SET RATEXT(7)=""
+14 SET RATEXT(8)="Error messages are stored in "_RAXT
+15 SET RATEXT(9)=""
+16 SET RA01=""
FOR RATXCNT=10:1
SET RA01=$ORDER(^XTMP("RA226_ERRORS","DIERR",RA01))
if RA01=""
QUIT
Begin DoDot:2
+17 SET RAEMSG=^XTMP("RA226_ERRORS","DIERR",RA01)
+18 SET RATEXT(RATXCNT)=RAEMSG_$SELECT(RAEMSG[RA01:"",1:" for "_RA01)
End DoDot:2
+19 QUIT
End DoDot:1
+20 ;XMTEXT for message text
+21 SET XMTEXT="RATEXT("
+22 SET XMSUB="RA*5.0*226 - Post-Init Results"
+23 ;postmaster
SET XMDUZ=.5
+24 ;Mail Recipients
+25 SET XMY(DUZ)=""
+26 SET RAMDUZ=.5
FOR
SET RAMDUZ=$ORDER(^XUSEC("RA MGR",RAMDUZ))
if RAMDUZ=""
QUIT
SET XMY(RAMDUZ)=""
+27 DO ^XMD
+28 QUIT
EN3 ;Clean-up the NEW RAD PROCEDURE WORKUP file (#71.11)
+1 NEW RADA,DA
+2 SET RADA=0
FOR
SET RADA=$ORDER(^RAMRPF(71.11,RADA))
if RADA=""
QUIT
Begin DoDot:1
+3 SET DIK="^RAMRPF(71.11,"
SET DA=RADA
DO ^DIK
+4 KILL DIK,DA
+5 QUIT
End DoDot:1
+6 QUIT
