Routine: RAMAIN5

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)

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

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  Feb 19, 2025@00:03:33                                                                                                                                                                                                     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

RAMAIN5.m