RANPRO5 ;BPFO/CLT - RADIOLOGY MAPPING TO MRPF ; 27 Oct 2016 4:28 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
N RADA,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,RAIEN
S RADA="",RACONT="" K ^XTMP("RANPRO4") 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=""
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(^RAMRPF(71.11,"B",RADA)) S:RADA="" $P(^RAMRPF(71.98,1,0),U,4)="Y" Q:RADA="" Q:RACONT["^" D
. S $P(^RAMRPF(71.98,1,0),U,5)=RADA
. S RAIEN=$O(^RAMRPF(71.11,"B",RADA,"")) Q:RAIEN="" D Q:$G(DIRUT)=1
.. I $P(^RAMRPF(71.11,RAIEN,0),U,6)'="D" Q
.. I $G(^RAMRPF(71.11,RAIEN,"I"))'=""&($G(^RAMRPF(71.11,RAIEN,"I"))<DT) Q
.. I $P($G(^RAMRPF(71.11,RAIEN,"NTRT")),U,1)'="" Q
.. ;I $G(^XTMP("RAMAIN4",$J,"RAEND"))=1 Q
.. K DIR S DIR(0)="71,.01",DIR("A")="LOCAL PROCEDURE NAME",DIR("?")="Enter the procedure name: ",DA=RAIEN D ^DIR
.. I X="^" S RAX="QUIT",RACONT="^" Q
.. ;K DIR,DIRUT S DIR(0)="71,9",DIR("?")="Enter the CPT code for this procedure:",DA=RAIEN D ^DIR Q:$G(DIRUT)=1 S RACPT=+Y
.. I X["^" Q
.. I $G(RAIEN)="" Q
.. I $G(Y(0))="NONE LISTED" Q
.. I $G(RANOT)=X Q
.. S RACPT=$P($G(^RAMIS(71,RAIEN,0)),"^",9) I RACPT="" Q
.. S RAMATCH="",DR="900///",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="^RAMRPF(71.11,",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
... ;I $G(X)="NONE LISTED" D MSG
... Q
.. I $G(Y(0))="NONE LISTED" D 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
G:RACONT["^" END
G:$D(DUOUT) END
MRPF ;FIND POSSIBLE MATCHES BY CPT
MRPF2 ;SECOND ENTRY POINT
Q:$G(RACPT)="" RAMATCH=""
N CNT,RAMERR,CNT1,II,A,RACINF
S RACODE="",RAPROIEN="",(CNT,I,II,CNT1)=0 K XC,XC2,RAMERR
S:$G(RAPROIEN)="" RAPROIEN=""
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^RANPROU2 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
MRPFL ; come here if no entries
K RAMERR,CNT1,II,A
;S RACODE=$G(RACODE)_$S($G(CNT)'="":(CNT+1),1:1)_":NONE LISTED",RANOT=$S($G(CNT)'="":(CNT+1),1:1)
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,CNT ;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="" G MEND
I $G(RAPROIEN)'="",$D(^RAMIS(71,"MRPF",$S($G(RAPROIEN)'="":RAPROIEN,1:0))) S RAMTCH=2 D:RAMATCH'="" MTCH^RANPROU2 I RAMATCH="QUIT" S RAMV=1 G END
; 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
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("RANPRO4"),RALOINC
K RAPLUSY,RAPRO1,X1,XC,XY,Z,DA,^UTILITY($J,"W")
K ^XTMP("RAMAIN4",$J),RAMTCH
Q
MSG K RACPT,RACODE,DIR,D,I,%X,%Y,D0,DI,DQ,DIRUT,DUOUT
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(^RAMRPF(71.11,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(^RAMRPF(71.11,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(^RAMRPF(71.11,DA,"NTRT"),U,3)=DT
S XMTEXT="RATXT(" D ^XMD
S $P(^RAMRPF(71.11,DA,"NTRT"),U,3)=DT
G END
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRANPRO5 6507 printed Nov 22, 2024@17:47:34 Page 2
RANPRO5 ;BPFO/CLT - RADIOLOGY MAPPING TO MRPF ; 27 Oct 2016 4:28 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 NEW RADA,RAPROIEN,DIE,DIC,DA,DR,X,Y,RACONT,RAMATCH,XC,RANOT,RAX,RACODE,RAFN,RAFAC,DUOUT,DIR
+2 NEW DTOUT,DUOUT,DIRUT,DIROUT,RATMP,XC2,RAXTMP,DIWF,DIWL,DIWR,RA99,RAIEN
+3 SET RADA=""
SET RACONT=""
KILL ^XTMP("RANPRO4")
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=""
+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(^RAMRPF(71.11,"B",RADA))
if RADA=""
SET $PIECE(^RAMRPF(71.98,1,0),U,4)="Y"
if RADA=""
QUIT
if RACONT["^"
QUIT
Begin DoDot:1
+4 SET $PIECE(^RAMRPF(71.98,1,0),U,5)=RADA
+5 SET RAIEN=$ORDER(^RAMRPF(71.11,"B",RADA,""))
if RAIEN=""
QUIT
Begin DoDot:2
+6 IF $PIECE(^RAMRPF(71.11,RAIEN,0),U,6)'="D"
QUIT
+7 IF $GET(^RAMRPF(71.11,RAIEN,"I"))'=""&($GET(^RAMRPF(71.11,RAIEN,"I"))<DT)
QUIT
+8 IF $PIECE($GET(^RAMRPF(71.11,RAIEN,"NTRT")),U,1)'=""
QUIT
+9 ;I $G(^XTMP("RAMAIN4",$J,"RAEND"))=1 Q
+10 KILL DIR
SET DIR(0)="71,.01"
SET DIR("A")="LOCAL PROCEDURE NAME"
SET DIR("?")="Enter the procedure name: "
SET DA=RAIEN
DO ^DIR
+11 IF X="^"
SET RAX="QUIT"
SET RACONT="^"
QUIT
+12 ;K DIR,DIRUT S DIR(0)="71,9",DIR("?")="Enter the CPT code for this procedure:",DA=RAIEN D ^DIR Q:$G(DIRUT)=1 S RACPT=+Y
+13 IF X["^"
QUIT
+14 IF $GET(RAIEN)=""
QUIT
+15 IF $GET(Y(0))="NONE LISTED"
QUIT
+16 IF $GET(RANOT)=X
QUIT
+17 SET RACPT=$PIECE($GET(^RAMIS(71,RAIEN,0)),"^",9)
IF RACPT=""
QUIT
+18 SET RAMATCH=""
SET DR="900///"
SET RAX=$$MRPF
if RAX["QUIT"!(RAMATCH="")
QUIT
+19 SET RATMP=$SELECT(RAPROIEN="":"",1:^RAMRPF(71.99,RAPROIEN,0))
+20 SET DR=DR_$PIECE(RATMP,U,1)_";903///"_$PIECE(RATMP,U,4)
if $GET(^XTMP("RAMAIN4",$JOB,"RAEND"))=""
Begin DoDot:3
+21 SET DIE="^RAMRPF(71.11,"
SET DA=RAIEN
+22 if $GET(X)=""
QUIT
+23 if $GET(X)="NONE LISTED"
QUIT
+24 if $GET(Y(0))="NONE LISTED"
QUIT
+25 DO ^DIE
WRITE !!,"MATCH MADE",!
KILL X,Y
QUIT
+26 ;I $G(X)="NONE LISTED" D MSG
+27 QUIT
End DoDot:3
+28 IF $GET(Y(0))="NONE LISTED"
DO MSG
+29 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
+30 QUIT
End DoDot:2
if $GET(DIRUT)=1
QUIT
+31 QUIT
End DoDot:1
+32 ;G:RACONT="Continue" EN
+33 if RACONT["^"
GOTO END
+34 if $DATA(DUOUT)
GOTO END
MRPF ;FIND POSSIBLE MATCHES BY CPT
MRPF2 ;SECOND ENTRY POINT
+1 if $GET(RACPT)=""
QUIT RAMATCH=""
+2 NEW CNT,RAMERR,CNT1,II,A,RACINF
+3 SET RACODE=""
SET RAPROIEN=""
SET (CNT,I,II,CNT1)=0
KILL XC,XC2,RAMERR
+4 if $GET(RAPROIEN)=""
SET RAPROIEN=""
+5 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^RANPROU2
if $GET(RA99)'="INACTIVE"
Begin DoDot:1
+6 ; RA*5.0*138 change '/' to '~'
+7 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
+8 QUIT
End DoDot:1
+9 KILL RACINF
MRPFL ; come here if no entries
+1 KILL RAMERR,CNT1,II,A
+2 ;S RACODE=$G(RACODE)_$S($G(CNT)'="":(CNT+1),1:1)_":NONE LISTED",RANOT=$S($G(CNT)'="":(CNT+1),1:1)
+3 SET RACODE=$GET(RACODE)_$SELECT($GET(I)'="":I,1:1)_":NONE LISTED"
SET RANOT=$SELECT($GET(I)'="":I,1:1)
+4 if $GET(RACODE)=""
QUIT $GET(RAMATCH)
MRPF3 ;LOOP POINT
KILL XC,XC2,CNT
+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=""
GOTO MEND
+21 IF $GET(RAPROIEN)'=""
IF $DATA(^RAMIS(71,"MRPF",$SELECT($GET(RAPROIEN)'="":RAPROIEN,1:0)))
SET RAMTCH=2
if RAMATCH'=""
DO MTCH^RANPROU2
IF RAMATCH="QUIT"
SET RAMV=1
GOTO END
+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 IF $GET(RAMATCH)="NONE LISTED"
SET RAMATCH=""
QUIT
+2 IF $GET(RAMATCH)=""
IF $GET(Y(0))["NONE LISTED"
SET RAMATCH="QUIT"
QUIT RAMATCH
+3 IF $GET(DUOUT)=1
SET RAX="QUIT"
SET RAMATCH=""
QUIT RAMATCH
+4 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("RANPRO4"),RALOINC
+2 KILL RAPLUSY,RAPRO1,X1,XC,XY,Z,DA,^UTILITY($JOB,"W")
+3 KILL ^XTMP("RAMAIN4",$JOB),RAMTCH
+4 QUIT
MSG KILL RACPT,RACODE,DIR,D,I,%X,%Y,D0,DI,DQ,DIRUT,DUOUT
+1 IF $PIECE($GET(^RARMPF(71.98,1,0)),U,10)'="Y"
GOTO END
+2 NEW XMSUB,XMY,XMTEXT,RATXT
+3 SET RAFAC=$$KSP^XUPARAM("INST")
SET RAFAC=$$NS^XUAF4(RAFAC)
+4 SET RAFN=$PIECE(RAFAC,U,1)
SET RAFAC=$PIECE(RAFAC,U,2)
SET $PIECE(^RAMRPF(71.11,DA,"NTRT"),U,2)="Y"
+5 SET XMSUB="NEW RADIOLOGY PROCEDURE"
+6 SET XMY(DUZ)=""
+7 SET XMY("G.RADIOLOGY NTRT@DOMAIN.EXT")=""
+8 SET XMY("G.NTRT")=""
+9 SET XMDUZ("G.RADNTRT")=""
+10 IF $PIECE($GET(^RAMRPF(71.98,1,0)),U,2)'=""
SET XMY($PIECE(^RAMRPF(71.98,1,0),U,2))=""
+11 SET RATXT(1)="An existing Radiology procedure at "_RAFN
+12 SET RATXT(2)="does not have a match in the MASTER RADIOLOGY PROCEDURE file"
+13 SET RATXT(3)=" "
+14 SET RATXT(4)="Facility Name/number: "_RAFN_" / "_RAFAC
+15 SET RATXT(5)=" "
+16 SET RATXT(6)="Procedure name: "_RADA
+17 SET RATXT(7)=" "
+18 SET RATXT(8)="CPT code: "_$PIECE($GET(^RAMRPF(71.11,DA,0)),U,9)
+19 SET RATXT(9)="Local IEN: "_DA
+20 SET RATXT(10)="For questions or notification respond to: "_"G.RADNTRT@"_$$KSP^XUPARAM("WHERE")
+21 SET RATXT(11)="For NTRT results respond to: "_"S.RADNEWPRO@"_$$KSP^XUPARAM("WHERE")
+22 SET $PIECE(^RAMRPF(71.11,DA,"NTRT"),U,3)=DT
+23 SET XMTEXT="RATXT("
DO ^XMD
+24 SET $PIECE(^RAMRPF(71.11,DA,"NTRT"),U,3)=DT
+25 GOTO END
