RAMAIN5 ;BPFO/CLT - RADIOLOGY MAPPING TO MRPF ; 28 Oct 2016 3:08 PM
;;5.0;Radiology/Nuclear Medicine;**127,138**;Mar 16, 1998;Build 22
;
; This routine uses the following IA's:
; #1995 - CPT calls (supported)
Q
EN ;MAIN ENTRY POINT
; RA*5.0*138 added RAMAIN5I usage
N RADA,RAIEN,RAPROIEN,DIE,DIC,DA,DR,X,Y,RACONT,RAMATCH,XC,RANOT,RAX,RACODE,RAFN,RAFAC,DUOUT,DIR
N DTOUT,DUOUT,DIRUT,DIROUT,RATMP,XC2,RAXTMP,DIWF,DIWL,DIWR,RA99,RAWALK,RAMAIN5I
S RADA="",RACONT="" K ^XTMP("RAMAIN4") S ^XTMP("RAMAIN4",$J,0)=""
LOOK ;LOOK FOR MAPPABLE PROCEDURES
S RADA=$P($G(^RAMRPF(71.98,1,0)),U,5) S:$G(RADA)="" RADA="" S:$G(RAWALK)="" RAWALK=""
I $P($G(^RAMRPF(71.98,1,0)),U,4)="Y" W !!?3,"Matching has been completed.",!?3,"Do you want to map exceptions?" S DIR(0)="Y",DIR("B")="NO" D ^DIR G:Y=0 END
F W !! S RACODE="",RATMP="",RADA=$O(^RAMIS(71,"B",RADA)) S:RADA="" $P(^RAMRPF(71.98,1,0),U,4)="Y" Q:RADA=""!(RACONT["^")!($G(RAX)="QUIT"&($G(RAWALK)=1)) D
. S $P(^RAMRPF(71.98,1,0),U,5)=RADA
. S RAIEN=$O(^RAMIS(71,"B",RADA,"")) Q:RAIEN="" D Q:$G(DIRUT)=1
.. I $P(^RAMIS(71,RAIEN,0),U,6)'="D" Q
.. I $G(^RAMIS(71,RAIEN,"I"))'=""&($G(^RAMIS(71,RAIEN,"I"))<DT) Q
.. I $P($G(^RAMIS(71,RAIEN,"NTRT")),U,1)'="" Q
.. ;I $G(^XTMP("RAMAIN4",$J,"RAEND"))=1 Q
.. W !!,"PROCEDURE NAME: ",$P(^RAMIS(71,RAIEN,0),U,1)
.. W !,"CPT CODE: ",$P(^RAMIS(71,RAIEN,0),U,9) S RACPT=$P(^RAMIS(71,RAIEN,0),U,9)
.. ; RA*5.0*138 added RAMAIN51
.. S RAMATCH="",DR="900///",RAWALK=1,RAMAIN5I=1
.. S RAX=$$MRPF() Q:RAX["QUIT"!(RAMATCH="")
.. S RATMP=$S(RAPROIEN="":"",1:^RAMRPF(71.99,RAPROIEN,0))
.. S DR=DR_$P(RATMP,U,1)_";903///"_$P(RATMP,U,4) D:$G(^XTMP("RAMAIN4",$J,"RAEND"))=""
... S DIE="^RAMIS(71,",DA=RAIEN
... Q:$G(X)=""
... Q:$G(X)="NONE LISTED"
... Q:$G(Y(0))="NONE LISTED"
... D ^DIE W !!,"MATCH MADE",! K X,Y Q
... Q
.. ; RA*5.0*138 added RAMAIN5I check
.. I $G(Y(0))="NONE LISTED" D:$G(RAMAIN5I)'=1 MSG
.. K DIR W ! S RACONT="" S DIR(0)="F^1:8",DIR("A")="Hit <RETURN> to continue or '^' to quit.",DIR("B")="Continue" D ^DIR S RACONT=Y
.. Q
. Q
;G:RACONT="Continue" EN
I RACONT["^" K RAWALK G END
I $D(DUOUT) K RAWALK G END
MRPF() ;FIND POSSIBLE MATCHES BY CPT
MRPF2 ;SECOND ENTRY POINT
N RACINF
Q:$G(RACPT)="" RAMATCH=""
S RACODE="",RAPROIEN="",I=0 K XC,XC2
S:$G(RAPROIEN)="" RAPROIEN="" F I=1:1 S RAPROIEN=$O(^RAMRPF(71.99,"C",RACPT,RAPROIEN)) D:'$D(^RAMRPF(71.99,"C",RACPT)) MSG Q:RAPROIEN="" D ACTIVE^RAUTL23 D:$G(RA99)'="INACTIVE"
. ; RA*5.0*138 change '/' to '~'
.S:$G(RACODE)="" RACODE="" S RACINF=$$CPT^ICPTCOD(RACPT),RACODE=RACODE_I_":"_$P(^RAMRPF(71.99,RAPROIEN,0),U,1)_"~"_$P(RACINF,"^",3)_";",^XTMP("RAMAIN4",$J,I)=RAPROIEN
. Q
K RACINF
S RACODE=$G(RACODE)_$S($G(I)'="":I,1:1)_":NONE LISTED",RANOT=$S($G(I)'="":I,1:1)
Q:$G(RACODE)="" $G(RAMATCH)
MRPF3 K XC,XC2 ;LOOP POINT
K DIR,DIE S DIR(0)="S^"_RACODE_"^",DIR("A",1)="Select the number of the Master Procedure that best matches",DIR("A")="or enter a number followed by'C' for the long name. e.g. 1C"
S DIR("PRE")="I X["_"""C"""_" S X=+X,XC=1"
D ^DIR G:$D(DUOUT) MEND G:Y["^"!(X["^") END S RAPLUSY=+Y I $G(XC)=1 D
. S ^XTMP("RAMAIN4",$J,"C")=$G(RACPT)_U_RACODE_U_$G(RAMATCH)_U_RAPROIEN_U_$G(XC)_U_RANOT_U_RAPLUSY,XC2=1
. I Y(0)["NONE LISTED" S XC2=XC Q
. S RAMATCH=$P(RACODE,";",+Y),RAMATCH=$P(RAMATCH,":",2),RAPLUSY=+Y
. S ^XTMP("RAMAIN4",$J,"C")=$G(RACPT)_U_RACODE_U_RAMATCH_U_RAPROIEN_U_XC_U_RANOT_U_RAPLUSY
. I $P(^XTMP("RAMAIN4",$J,"C"),U,2)="1:NON LISTED" S XC2=1 Q
. K ^UTILITY($J,"W") S DIWL=10,DIWR=70,DIWF="WC60"
. S RAPRO1=^XTMP("RAMAIN4",$J,+Y),RAPLUSY=+Y
. S X1=0 F S X1=$O(^RAMRPF(71.99,RAPRO1,1,X1)) Q:X1="" D
.. S X=^RAMRPF(71.99,RAPRO1,1,X1,0) D ^DIWP
.. Q
. D ^DIWW
. W !?3,"Enter <RETURN> to continue:" R X:600 Q
I $G(XC2)=1 S RAXTMP=^XTMP("RAMAIN4",$J,"C") D
. S RACPT=$P(RAXTMP,U,1),RACODE=$P(RAXTMP,U,2),RAMATCH=$P(RAXTMP,U,3),RAPROIEN=$P(RAXTMP,U,4),XC=$P(RAXTMP,U,5),RANOT=$P(RAXTMP,U,7),(RAPLUSY,Y)=$P(RAXTMP,U,8) S I=""
G:$G(XC2)=1 MRPF3 S:$G(Y)'=$G(RANOT) RAMATCH=$P(RACODE,";",RAPLUSY),RAMATCH=$P(RAMATCH,":",2)
I RACODE'="1:NONE LISTED"&(Y(0)'="NONE LISTED") S:$G(RAPROIEN)="" RAPROIEN=^XTMP("RAMAIN4",$J,+Y)
I $G(RACODE)["1:NONE LISTED"!($G(Y(0))["NONE LISTED") S RAX="QUIT",RAMATCH="",RAWALK=0 G MEND
I $G(RAPROIEN)'="",$D(^RAMIS(71,"MRPF",$S($G(RAPROIEN)'="":RAPROIEN,1:0))) S RAMTCH=2 D:RAMATCH'="GO" MTCH^RAUTL23
; RA*5.0*138 change '/' to '~'
S:+Y'=RANOT RAMATCH=$P(RAMATCH,"~",1) I $P(RACODE,";",Y)'["NONE LISTED" S RAPROIEN=^XTMP("RAMAIN4",$J,+Y)
MEND ;GO HERE WHEN AN UPARROW ENTERED ON A DIR
;W !!,X," ",$G(DUOUT,999)," ",$G(RAMATCH,9999)
I $D(DUOUT) S RAX="QUIT",RAMATCH="" Q RAX
I $G(RAMATCH)="NONE LISTED" S RAMATCH="" Q
I $G(RAMATCH)="",$G(Y(0))["NONE LISTED" S RAMATCH="QUIT" Q RAMATCH
I $G(DUOUT)=1 S RAX="QUIT",RAMATCH="" Q RAMATCH
S RAMATCH="GO" Q RAMATCH
END ;END ROUTINE
K RACPT,RACODE,DIR,D,I,%X,%Y,D0,DI,DQ,DIRUT,DUOUT,XMDUN,XMDUZ,XMZ,^XTMP("RAMAIN4"),RALOINC
K RAPLUSY,RAPRO1,X1,XC,XY,Z,DA,^UTILITY($J,"W"),RAMAIN5I
K ^XTMP("RAMAIN4",$J),RAMATCH,RAMTCH
Q
MSG K RACPT,RACODE,DIR,D,I,%X,%Y,D0,DI,DQ,DIRUT,DUOUT
; RA*5.0*138 added RAMAIN5I check
I $G(RAMAIN5I)=1 G END
I $P($G(^RARMPF(71.98,1,0)),U,10)'="Y" G END
N XMSUB,XMY,XMTEXT,RATXT
S RAFAC=$$KSP^XUPARAM("INST"),RAFAC=$$NS^XUAF4(RAFAC)
S RAFN=$P(RAFAC,U,1),RAFAC=$P(RAFAC,U,2),$P(^RAMIS(71,DA,"NTRT"),U,2)="Y"
S XMSUB="NEW RADIOLOGY PROCEDURE"
S XMY(DUZ)=""
S XMY("G.RADIOLOGY NTRT@DOMAIN.EXT")=""
S XMY("G.NTRT")=""
S XMDUZ("G.RADNTRT")=""
I $P($G(^RAMRPF(71.98,1,0)),U,2)'="" S XMY($P(^RAMRPF(71.98,1,0),U,2))=""
S RATXT(1)="An existing Radiology procedure at "_RAFN
S RATXT(2)="does not have a match in the MASTER RADIOLOGY PROCEDURE file"
S RATXT(3)=" "
S RATXT(4)="Facility Name/number: "_RAFN_" / "_RAFAC
S RATXT(5)=" "
S RATXT(6)="Procedure name: "_RADA
S RATXT(7)=" "
S RATXT(8)="CPT code: "_$P($G(^RAMIS(71,DA,0)),U,9)
S RATXT(9)="Local IEN: "_DA
S RATXT(10)="For questions or notification respond to: "_"G.RADNTRT@"_$$KSP^XUPARAM("WHERE")
S RATXT(11)="For NTRT results respond to: "_"S.RADNEWPRO@"_$$KSP^XUPARAM("WHERE")
S $P(^RAMIS(71,DA,"NTRT"),U,3)=DT
S XMTEXT="RATXT(" D ^XMD
S $P(^RAMIS(71,DA,"NTRT"),U,3)=DT
G END
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAMAIN5 6303 printed Dec 13, 2024@02:37:17 Page 2
RAMAIN5 ;BPFO/CLT - RADIOLOGY MAPPING TO MRPF ; 28 Oct 2016 3:08 PM
+1 ;;5.0;Radiology/Nuclear Medicine;**127,138**;Mar 16, 1998;Build 22
+2 ;
+3 ; This routine uses the following IA's:
+4 ; #1995 - CPT calls (supported)
+5 QUIT
EN ;MAIN ENTRY POINT
+1 ; RA*5.0*138 added RAMAIN5I usage
+2 NEW RADA,RAIEN,RAPROIEN,DIE,DIC,DA,DR,X,Y,RACONT,RAMATCH,XC,RANOT,RAX,RACODE,RAFN,RAFAC,DUOUT,DIR
+3 NEW DTOUT,DUOUT,DIRUT,DIROUT,RATMP,XC2,RAXTMP,DIWF,DIWL,DIWR,RA99,RAWALK,RAMAIN5I
+4 SET RADA=""
SET RACONT=""
KILL ^XTMP("RAMAIN4")
SET ^XTMP("RAMAIN4",$JOB,0)=""
LOOK ;LOOK FOR MAPPABLE PROCEDURES
+1 SET RADA=$PIECE($GET(^RAMRPF(71.98,1,0)),U,5)
if $GET(RADA)=""
SET RADA=""
if $GET(RAWALK)=""
SET RAWALK=""
+2 IF $PIECE($GET(^RAMRPF(71.98,1,0)),U,4)="Y"
WRITE !!?3,"Matching has been completed.",!?3,"Do you want to map exceptions?"
SET DIR(0)="Y"
SET DIR("B")="NO"
DO ^DIR
if Y=0
GOTO END
+3 FOR
WRITE !!
SET RACODE=""
SET RATMP=""
SET RADA=$ORDER(^RAMIS(71,"B",RADA))
if RADA=""
SET $PIECE(^RAMRPF(71.98,1,0),U,4)="Y"
if RADA=""!(RACONT["^")!($GET(RAX)="QUIT"&($GET(RAWALK)=1))
QUIT
Begin DoDot:1
+4 SET $PIECE(^RAMRPF(71.98,1,0),U,5)=RADA
+5 SET RAIEN=$ORDER(^RAMIS(71,"B",RADA,""))
if RAIEN=""
QUIT
Begin DoDot:2
+6 IF $PIECE(^RAMIS(71,RAIEN,0),U,6)'="D"
QUIT
+7 IF $GET(^RAMIS(71,RAIEN,"I"))'=""&($GET(^RAMIS(71,RAIEN,"I"))<DT)
QUIT
+8 IF $PIECE($GET(^RAMIS(71,RAIEN,"NTRT")),U,1)'=""
QUIT
+9 ;I $G(^XTMP("RAMAIN4",$J,"RAEND"))=1 Q
+10 WRITE !!,"PROCEDURE NAME: ",$PIECE(^RAMIS(71,RAIEN,0),U,1)
+11 WRITE !,"CPT CODE: ",$PIECE(^RAMIS(71,RAIEN,0),U,9)
SET RACPT=$PIECE(^RAMIS(71,RAIEN,0),U,9)
+12 ; RA*5.0*138 added RAMAIN51
+13 SET RAMATCH=""
SET DR="900///"
SET RAWALK=1
SET RAMAIN5I=1
+14 SET RAX=$$MRPF()
if RAX["QUIT"!(RAMATCH="")
QUIT
+15 SET RATMP=$SELECT(RAPROIEN="":"",1:^RAMRPF(71.99,RAPROIEN,0))
+16 SET DR=DR_$PIECE(RATMP,U,1)_";903///"_$PIECE(RATMP,U,4)
if $GET(^XTMP("RAMAIN4",$JOB,"RAEND"))=""
Begin DoDot:3
+17 SET DIE="^RAMIS(71,"
SET DA=RAIEN
+18 if $GET(X)=""
QUIT
+19 if $GET(X)="NONE LISTED"
QUIT
+20 if $GET(Y(0))="NONE LISTED"
QUIT
+21 DO ^DIE
WRITE !!,"MATCH MADE",!
KILL X,Y
QUIT
+22 QUIT
End DoDot:3
+23 ; RA*5.0*138 added RAMAIN5I check
+24 IF $GET(Y(0))="NONE LISTED"
if $GET(RAMAIN5I)'=1
DO MSG
+25 KILL DIR
WRITE !
SET RACONT=""
SET DIR(0)="F^1:8"
SET DIR("A")="Hit <RETURN> to continue or '^' to quit."
SET DIR("B")="Continue"
DO ^DIR
SET RACONT=Y
+26 QUIT
End DoDot:2
if $GET(DIRUT)=1
QUIT
+27 QUIT
End DoDot:1
+28 ;G:RACONT="Continue" EN
+29 IF RACONT["^"
KILL RAWALK
GOTO END
+30 IF $DATA(DUOUT)
KILL RAWALK
GOTO END
MRPF() ;FIND POSSIBLE MATCHES BY CPT
MRPF2 ;SECOND ENTRY POINT
+1 NEW RACINF
+2 if $GET(RACPT)=""
QUIT RAMATCH=""
+3 SET RACODE=""
SET RAPROIEN=""
SET I=0
KILL XC,XC2
+4 if $GET(RAPROIEN)=""
SET RAPROIEN=""
FOR I=1:1
SET RAPROIEN=$ORDER(^RAMRPF(71.99,"C",RACPT,RAPROIEN))
if '$DATA(^RAMRPF(71.99,"C",RACPT))
DO MSG
if RAPROIEN=""
QUIT
DO ACTIVE^RAUTL23
if $GET(RA99)'="INACTIVE"
Begin DoDot:1
+5 ; RA*5.0*138 change '/' to '~'
+6 if $GET(RACODE)=""
SET RACODE=""
SET RACINF=$$CPT^ICPTCOD(RACPT)
SET RACODE=RACODE_I_":"_$PIECE(^RAMRPF(71.99,RAPROIEN,0),U,1)_"~"_$PIECE(RACINF,"^",3)_";"
SET ^XTMP("RAMAIN4",$JOB,I)=RAPROIEN
+7 QUIT
End DoDot:1
+8 KILL RACINF
+9 SET RACODE=$GET(RACODE)_$SELECT($GET(I)'="":I,1:1)_":NONE LISTED"
SET RANOT=$SELECT($GET(I)'="":I,1:1)
+10 if $GET(RACODE)=""
QUIT $GET(RAMATCH)
MRPF3 ;LOOP POINT
KILL XC,XC2
+1 KILL DIR,DIE
SET DIR(0)="S^"_RACODE_"^"
SET DIR("A",1)="Select the number of the Master Procedure that best matches"
SET DIR("A")="or enter a number followed by'C' for the long name. e.g. 1C"
+2 SET DIR("PRE")="I X["_"""C"""_" S X=+X,XC=1"
+3 DO ^DIR
if $DATA(DUOUT)
GOTO MEND
if Y["^"!(X["^")
GOTO END
SET RAPLUSY=+Y
IF $GET(XC)=1
Begin DoDot:1
+4 SET ^XTMP("RAMAIN4",$JOB,"C")=$GET(RACPT)_U_RACODE_U_$GET(RAMATCH)_U_RAPROIEN_U_$GET(XC)_U_RANOT_U_RAPLUSY
SET XC2=1
+5 IF Y(0)["NONE LISTED"
SET XC2=XC
QUIT
+6 SET RAMATCH=$PIECE(RACODE,";",+Y)
SET RAMATCH=$PIECE(RAMATCH,":",2)
SET RAPLUSY=+Y
+7 SET ^XTMP("RAMAIN4",$JOB,"C")=$GET(RACPT)_U_RACODE_U_RAMATCH_U_RAPROIEN_U_XC_U_RANOT_U_RAPLUSY
+8 IF $PIECE(^XTMP("RAMAIN4",$JOB,"C"),U,2)="1:NON LISTED"
SET XC2=1
QUIT
+9 KILL ^UTILITY($JOB,"W")
SET DIWL=10
SET DIWR=70
SET DIWF="WC60"
+10 SET RAPRO1=^XTMP("RAMAIN4",$JOB,+Y)
SET RAPLUSY=+Y
+11 SET X1=0
FOR
SET X1=$ORDER(^RAMRPF(71.99,RAPRO1,1,X1))
if X1=""
QUIT
Begin DoDot:2
+12 SET X=^RAMRPF(71.99,RAPRO1,1,X1,0)
DO ^DIWP
+13 QUIT
End DoDot:2
+14 DO ^DIWW
+15 WRITE !?3,"Enter <RETURN> to continue:"
READ X:600
QUIT
End DoDot:1
+16 IF $GET(XC2)=1
SET RAXTMP=^XTMP("RAMAIN4",$JOB,"C")
Begin DoDot:1
+17 SET RACPT=$PIECE(RAXTMP,U,1)
SET RACODE=$PIECE(RAXTMP,U,2)
SET RAMATCH=$PIECE(RAXTMP,U,3)
SET RAPROIEN=$PIECE(RAXTMP,U,4)
SET XC=$PIECE(RAXTMP,U,5)
SET RANOT=$PIECE(RAXTMP,U,7)
SET (RAPLUSY,Y)=$PIECE(RAXTMP,U,8)
SET I=""
End DoDot:1
+18 if $GET(XC2)=1
GOTO MRPF3
if $GET(Y)'=$GET(RANOT)
SET RAMATCH=$PIECE(RACODE,";",RAPLUSY)
SET RAMATCH=$PIECE(RAMATCH,":",2)
+19 IF RACODE'="1:NONE LISTED"&(Y(0)'="NONE LISTED")
if $GET(RAPROIEN)=""
SET RAPROIEN=^XTMP("RAMAIN4",$JOB,+Y)
+20 IF $GET(RACODE)["1:NONE LISTED"!($GET(Y(0))["NONE LISTED")
SET RAX="QUIT"
SET RAMATCH=""
SET RAWALK=0
GOTO MEND
+21 IF $GET(RAPROIEN)'=""
IF $DATA(^RAMIS(71,"MRPF",$SELECT($GET(RAPROIEN)'="":RAPROIEN,1:0)))
SET RAMTCH=2
if RAMATCH'="GO"
DO MTCH^RAUTL23
+22 ; RA*5.0*138 change '/' to '~'
+23 if +Y'=RANOT
SET RAMATCH=$PIECE(RAMATCH,"~",1)
IF $PIECE(RACODE,";",Y)'["NONE LISTED"
SET RAPROIEN=^XTMP("RAMAIN4",$JOB,+Y)
MEND ;GO HERE WHEN AN UPARROW ENTERED ON A DIR
+1 ;W !!,X," ",$G(DUOUT,999)," ",$G(RAMATCH,9999)
+2 IF $DATA(DUOUT)
SET RAX="QUIT"
SET RAMATCH=""
QUIT RAX
+3 IF $GET(RAMATCH)="NONE LISTED"
SET RAMATCH=""
QUIT
+4 IF $GET(RAMATCH)=""
IF $GET(Y(0))["NONE LISTED"
SET RAMATCH="QUIT"
QUIT RAMATCH
+5 IF $GET(DUOUT)=1
SET RAX="QUIT"
SET RAMATCH=""
QUIT RAMATCH
+6 SET RAMATCH="GO"
QUIT RAMATCH
END ;END ROUTINE
+1 KILL RACPT,RACODE,DIR,D,I,%X,%Y,D0,DI,DQ,DIRUT,DUOUT,XMDUN,XMDUZ,XMZ,^XTMP("RAMAIN4"),RALOINC
+2 KILL RAPLUSY,RAPRO1,X1,XC,XY,Z,DA,^UTILITY($JOB,"W"),RAMAIN5I
+3 KILL ^XTMP("RAMAIN4",$JOB),RAMATCH,RAMTCH
+4 QUIT
MSG KILL RACPT,RACODE,DIR,D,I,%X,%Y,D0,DI,DQ,DIRUT,DUOUT
+1 ; RA*5.0*138 added RAMAIN5I check
+2 IF $GET(RAMAIN5I)=1
GOTO END
+3 IF $PIECE($GET(^RARMPF(71.98,1,0)),U,10)'="Y"
GOTO END
+4 NEW XMSUB,XMY,XMTEXT,RATXT
+5 SET RAFAC=$$KSP^XUPARAM("INST")
SET RAFAC=$$NS^XUAF4(RAFAC)
+6 SET RAFN=$PIECE(RAFAC,U,1)
SET RAFAC=$PIECE(RAFAC,U,2)
SET $PIECE(^RAMIS(71,DA,"NTRT"),U,2)="Y"
+7 SET XMSUB="NEW RADIOLOGY PROCEDURE"
+8 SET XMY(DUZ)=""
+9 SET XMY("G.RADIOLOGY NTRT@DOMAIN.EXT")=""
+10 SET XMY("G.NTRT")=""
+11 SET XMDUZ("G.RADNTRT")=""
+12 IF $PIECE($GET(^RAMRPF(71.98,1,0)),U,2)'=""
SET XMY($PIECE(^RAMRPF(71.98,1,0),U,2))=""
+13 SET RATXT(1)="An existing Radiology procedure at "_RAFN
+14 SET RATXT(2)="does not have a match in the MASTER RADIOLOGY PROCEDURE file"
+15 SET RATXT(3)=" "
+16 SET RATXT(4)="Facility Name/number: "_RAFN_" / "_RAFAC
+17 SET RATXT(5)=" "
+18 SET RATXT(6)="Procedure name: "_RADA
+19 SET RATXT(7)=" "
+20 SET RATXT(8)="CPT code: "_$PIECE($GET(^RAMIS(71,DA,0)),U,9)
+21 SET RATXT(9)="Local IEN: "_DA
+22 SET RATXT(10)="For questions or notification respond to: "_"G.RADNTRT@"_$$KSP^XUPARAM("WHERE")
+23 SET RATXT(11)="For NTRT results respond to: "_"S.RADNEWPRO@"_$$KSP^XUPARAM("WHERE")
+24 SET $PIECE(^RAMIS(71,DA,"NTRT"),U,3)=DT
+25 SET XMTEXT="RATXT("
DO ^XMD
+26 SET $PIECE(^RAMIS(71,DA,"NTRT"),U,3)=DT
+27 GOTO END
