RANPRO4 ;BPFO/CLT - RADIOLOGY NEW PROCEDURE UTILITIES ; 27 Oct 2016 4:32 PM
;;5.0;Radiology/Nuclear Medicine;**127,138**;Mar 16, 1998;Build 22
;
Q
EN(RADA) ;PRIMARY ENTRY POINT
N DIR,RATYPE,RAFAC,RAFN,RACODE,RAGOLD,RAMATCH,RANM,RANOT,RAPLUSY,RAPROIEN,XMDUN,RANEWPRO
N P1,P2,RA901
I $G(DA)'="",$G(RADA)="" S RADA=DA
S RANM=RAPNM,^XTMP("RAMAIN4",$J,"RAEND")=0,RADA=+RADA
GOOD ;ACCEPT ENTRY AND ASSIGN CPT
S RATYPE=$P(^RAMRPF(71.11,RADA,0),U,6) D:RATYPE'="D"
.W !!?3,"The type of this exam has been chosen not to be DETAILED."," An NTRT process",!?3,"will not be initiated. And no MRPF matching will be performed.",!
.Q
Q:RATYPE'="D"
K DIR,DIR(0),DIR("A"),DIR("B")
I $G(RA7111DA)="" S RA7111DA=$G(^TMP("RA7111DA",$J))
K DIR S DIR(0)="Y",DIR("A")="Are you sure you are entering "_$P(^RAMRPF(71.11,RA7111DA,0),U,1)_" as a new procedure"
;K DIR S DIR(0)="Y",DIR("A")="Are you sure you are entering "_$P(^RAMRPF(71.11,1,0),U,1)_" as a new procedure"
S RASEED=" " S RASEED=$S($P($G(^RAMRPF(71.98,1,0)),U,10)'="Y":" not ",1:" ")
S DIR("A",1)="This entry will"_RASEED_"be submitted for NTRT processing."
S DIR("B")="YES"
W ! D ^DIR S:Y=0 ^XTMP("RAMAIN4",$J,"RAEND")=1 G:^XTMP("RAMAIN4",$J,"RAEND")=1 END
CPTEN ;Enter the CPT code
I $G(RAX)="QUIT"!(X["^") G END
W !!,"The CPT code is needed to match to an entry within the MASTER",!,"RADIOLOGY PROCEDURE file."
I $G(RACPT)'="" W !!,"The CPT code for this procedure is ",RACPT,"."
I $G(RACPT)="" K DIR S DIR(0)="71,9^^",DIR("A")="Enter the CPT code for this procedure, if the CPT code is known"
I $G(RACPT)="" K DIRUT,DIROUT,DUOUT W ! D ^DIR I $G(DIRUT)=1 G END
S:X>0 $P(^RAMRPF(71.11,RADA,0),U,9)=X,RACPT=X
S DA=RADA D MRPF^RANPRO5 S RAGOLD=RAMATCH
I $D(DUOUT)!($G(Y(0))="")!($G(RANQUIT)=1) W !!,*7,"No MRPF match made.",!! G END
I $G(RAPROIEN)'="",($G(RANQUIT)'=1),$D(^RAMIS(71,"MRPF",$S($G(RAPROIEN)'="":RAPROIEN,1:0))) S RAMTCH=1 D MTCH^RANPROU2
G:$G(RANQUIT)=1 END
; RA*5.0*138 corrected set value of 900, added check for active NTRT on 903 set
I Y(0)'["NONE LISTED" S DA=RADA,DIE="^RAMRPF(71.11,",DIE(0)="L",DR="900///"_RAPROIEN_";902///"_DT_";903///"_($S($P($G(^RAMRPF(71.98,1,0)),U,10)'="Y":"",1:$P($G(^RAMRPF(71.99,RAPROIEN,0)),U,4))) S DA=RADA D ^DIE D
. I $G(RAPROIEN)'="" W !?3,"You have mapped this procedure to "_$P($G(^RAMRPF(71.99,RAPROIEN,0)),U,1) Q
I $G(Y(0))["NONE LISTED" D
. ; RA*5.0*138 change RAMIS(71 to RAMRPF(71.11
. S DA=RADA,DIE="^RAMRPF(71.11,",DIE(0)="L"
. S DR="901///" S RA901=$S($P($G(^RAMRPF(71.98,1,0)),U,10)="Y":"Y",1:"")
. S DR=DR_RA901_";902///"_DT D ^DIE
. Q
; RA*5.0*138 remove hard set of indexes
;S $P(^RAMRPF(71.11,RADA,"NTRT"),U,3)=DT,^RAMRPF(71.11,"CREAT",DT,RADA)=""
;I $P($G(^RAMRPF(71.98,1,0)),U,10)'="Y" S $P(^RAMRPF(71.11,RADA,"NTRT"),U,3)=""
MSG ;SEND A MESSAGE TO GATEKEEPER
I $P($G(^RAMRPF(71.98,1,0)),U,10)'="Y" Q RADA
N XMSUB,XMY,XMTEXT,RATXT Q:$P($G(^RAMRPF(71.11,RADA,"NTRT")),U,1)'="" RADA
S XMSUB="NEW RADIOLOGY PROCEDURE"
S XMY(DUZ)=""
I $P($G(^RAMRPF(71.98,1,0)),U,2)'="" S XMY($P(^RAMRPF(71.98,1,0),U,2))=""
S RATXT(1)="A new Radiology procedure has been entered."
S RATXT(3)="This procedure will be submitted for NTRT processing."
S RATXT(4)=" "
S RATXT(5)=" "
;S RATXT(7)=" "
I $G(RA7111DA)="" S RA7111DA=$G(^TMP("RA7111DA",$J))
S RATXT(7)="Procedure Name: "_$P(^RAMRPF(71.11,RA7111DA,0),U,1)
;S RATXT(7)="Procedure Name: "_$P(^RAMRPF(71.11,1,0),U,1)
S RATXT(8)="CPT: "_$P($G(^RAMRPF(71.11,RADA,0)),U,9)
S XMTEXT="RATXT(" D ^XMD
I $P($G(^RAMRPF(71.98,1,0)),U,10)'="Y" Q RADA
Q:$P($G(^RAMRPF(71.11,RADA,"NTRT")),U,1)'="" RADA
S RANMSG=1
G END
MSG1 ;MESSAGE TO NTRT
;I $P($G(^RAMRPF(71.98,1,0)),U,10)'="Y" Q RADA
I $P($G(^RAMRPF(71.98,1,0)),U,10)'="Y" Q
;N XMSUB,XMY,XMTEXT,RATXT Q:$P($G(^RAMIS(71,RADA,"NTRT")),U,1)'="" RADA
N XMSUB,XMY,XMTEXT,RATXT,XMDUN,XMDUZ,XMZ,RAFAC,RAFN
I $P($G(^RAMIS(71,RADA,"NTRT")),U,1)'="" Q
S RAFAC=$$KSP^XUPARAM("INST"),RAFAC=$$NS^XUAF4(RAFAC)
;S RAFN=$P(RAFAC,U,1),RAFAC=$P(RAFAC,U,2),$P(^RAMRPF(71.11,RADA,"NTRT"),U,2)="Y"
N DA,DIE,DR S DIE="^RAMIS(71,",DR="901///Y",DA=RADA D ^DIE K DA,DIE,DR
S RAFN=$P(RAFAC,U,1),RAFAC=$P(RAFAC,U,2)
;S RAFN=$P(RAFAC,U,1),RAFAC=$P(RAFAC,U,2),$P(^RAMIS(71,RADA,"NTRT"),U,2)="Y"
S XMSUB="NEW RADIOLOGY PROCEDURE"
S XMY("G.RADIOLOGY NTRT@DOMAIN.EXT")=""
S XMY("G.RADNTRT")=""
S XMDUZ("G.RADNTRT")=""
S XMY(DUZ)=""
I $P($G(^RAMRPF(71.98,1,0)),U,2)'="" S XMY($P(^RAMRPF(71.98,1,0),U,2))=""
;S XMY("G.RADIOLOGY NTRT@DOMAIN.EXT")=""
S RATXT(1)="A new Radiology procedure has been entered at "_RAFN
S RATXT(2)=" "
S RATXT(3)="Facility Name/number: "_RAFN_" / "_RAFAC
S RATXT(4)=" "
I $G(RA7111DA)="" S RA7111DA=$G(^TMP("RA7111DA",$J))
S RATXT(5)="Procedure name: "_$P(^RAMIS(71,RADA,0),U,1)
;S RATXT(5)="Procedure name: "_$P(^RAMRPF(71.11,RA7111DA,0),U,1)
;S RATXT(5)="Procedure name: "_$P(^RAMRPF(71.11,1,0),U,1)
S RATXT(6)=" "
S RATXT(7)="CPT code: "_$P($G(^RAMIS(71,RADA,0)),U,9)
;S RATXT(7)="CPT code: "_$P($G(^RAMRPF(71.11,RADA,0)),U,9)
S RATXT(8)="Local IEN: "_RADA
S RATXT(9)="For questions or notification respond to: "_"G.RADNTRT@"_$$KSP^XUPARAM("WHERE")
S RATXT(10)="For NTRT results respond to: "_"S.RANEWPRO@"_$$KSP^XUPARAM("WHERE")
;I $P($G(^RAMRPF(71.98,1,0)),U,9)="Y" D XML G END
S $P(^RAMIS(71,RADA,"NTRT"),U,4)=DT
;S $P(^RAMRPF(71.11,RADA,"NTRT"),U,4)=DT
S XMTEXT="RATXT(" D ^XMD
;S $P(^RAMIS(71,RADA,"NTRT"),U,4)=DT
I $P($G(^RAMRPF(71.98,1,0)),U,9)="Y" D XML
K XMSUB,XMY,XMTEXT,RATXT,XMDUN,XMDUZ,XMZ,RAFAC,RAFN
Q
;
XML ; NTRT message for ISAAC
; Need P1 ISAAC SCHEMA NAME
; Need P2 ISAAC SCHEMA PATH
; get the schemea name and the schema path
N P1,P2,A,C
S P1=$$GET1^DIQ(71.98,"1,",11.6)
S P2=$$GET1^DIQ(71.98,"1,",7)
S A=$TR(P1,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
I P1'=""&($E(A,($L(A)-4),$L(A)))'=".XSD" S P1=P1_".XSD"
I P2'="" D ;<
. I $E(P2,1,2)'="//" S P2="//"_P2
. I $E(P2,$L(P2))="/" S P2=P2_$E(P2,1,($L(P2)-1))
S A="uri:"_P2_P1
S XMSUB="NEW RADIOLOGY PROCEDURE"
K RATXT
S RATXT(1)=$$XMLHDR^MXMLUTL()
S RATXT(2)="<DATAEXTRACTS xmlns="""_A_""" xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"""
S RATXT(3)=">"
S RATXT(4)="<RAD_NTRT>"
S RATXT(5)="<Facility_Name/number>"_RAFN_" / "_RAFAC_"</Facility_Name/number>"
S RATXT(6)="<Facility_Group_e-mail>"_"G.RADNTRT@"_$$KSP^XUPARAM("WHERE")_"</Facility_Group_e-mail>"
S RATXT(7)="<Procedure_name>"_RANM_"</Procedure_name>"
S RATXT(8)="<CPT_code>"_$P($G(^RAMIS(71,RADA,0)),U,9)_"</CPT_code>"
;S RATXT(8)="<CPT_code>"_$P($G(^RAMRPF(71.11,RADA,0)),U,9)_"</CPT_code>"
S RATXT(9)="<Local_IEN>"_RADA_"</Local_IEN>"
S RATXT(10)="<NTRT_results_response_e-mail>"_"S.RANEWPRO@"_$$KSP^XUPARAM("WHERE")_"</NTRT_results_response_e-mail>"
S RATXT(11)="</RAD_NTRT>"
S RATXT(12)="</DATAEXTRACTS>"
S RAXTMPNM=XMSUB
;D XMLSND^RAXMLSND(RAXTMPNM)
N RADUZ,RA71IEN,RAS
S RADUZ=DUZ,RA71IEN=RADA,RAS=""
D EN^RAXMLSND
K RADUZ,RA71IEN,RAS,RATXT
Q
;
DEACT ;BLOCK INACTIVATION DATE
Q
I $P($G(^RAMRPF(71.98,1,0)),U,3)'="" D
. S X1=DT,X2=$P(^RAMRPF(71.98,1,0),U,3)
. D C^%DTC
. S ^RAMRPF(71.11,RADA,"I")=X,$P(^RAMRPF(71.11,RADA,"NTRT"),U,2)="Y"
Q
END ;KILL LOCAL VARIABLES AND END
K RATXT,XMZ,XMDUN,XMDUZ,X,Y
Q $G(RANEWPRO)
;
MSGRAN(RADA) ; entry from RANPRO after file to 71 to send NTRT message
G MSG1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRANPRO4 7437 printed Nov 22, 2024@17:47:33 Page 2
RANPRO4 ;BPFO/CLT - RADIOLOGY NEW PROCEDURE UTILITIES ; 27 Oct 2016 4:32 PM
+1 ;;5.0;Radiology/Nuclear Medicine;**127,138**;Mar 16, 1998;Build 22
+2 ;
+3 QUIT
EN(RADA) ;PRIMARY ENTRY POINT
+1 NEW DIR,RATYPE,RAFAC,RAFN,RACODE,RAGOLD,RAMATCH,RANM,RANOT,RAPLUSY,RAPROIEN,XMDUN,RANEWPRO
+2 NEW P1,P2,RA901
+3 IF $GET(DA)'=""
IF $GET(RADA)=""
SET RADA=DA
+4 SET RANM=RAPNM
SET ^XTMP("RAMAIN4",$JOB,"RAEND")=0
SET RADA=+RADA
GOOD ;ACCEPT ENTRY AND ASSIGN CPT
+1 SET RATYPE=$PIECE(^RAMRPF(71.11,RADA,0),U,6)
if RATYPE'="D"
Begin DoDot:1
+2 WRITE !!?3,"The type of this exam has been chosen not to be DETAILED."," An NTRT process",!?3,"will not be initiated. And no MRPF matching will be performed.",!
+3 QUIT
End DoDot:1
+4 if RATYPE'="D"
QUIT
+5 KILL DIR,DIR(0),DIR("A"),DIR("B")
+6 IF $GET(RA7111DA)=""
SET RA7111DA=$GET(^TMP("RA7111DA",$JOB))
+7 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Are you sure you are entering "_$PIECE(^RAMRPF(71.11,RA7111DA,0),U,1)_" as a new procedure"
+8 ;K DIR S DIR(0)="Y",DIR("A")="Are you sure you are entering "_$P(^RAMRPF(71.11,1,0),U,1)_" as a new procedure"
+9 SET RASEED=" "
SET RASEED=$SELECT($PIECE($GET(^RAMRPF(71.98,1,0)),U,10)'="Y":" not ",1:" ")
+10 SET DIR("A",1)="This entry will"_RASEED_"be submitted for NTRT processing."
+11 SET DIR("B")="YES"
+12 WRITE !
DO ^DIR
if Y=0
SET ^XTMP("RAMAIN4",$JOB,"RAEND")=1
if ^XTMP("RAMAIN4",$JOB,"RAEND")=1
GOTO END
CPTEN ;Enter the CPT code
+1 IF $GET(RAX)="QUIT"!(X["^")
GOTO END
+2 WRITE !!,"The CPT code is needed to match to an entry within the MASTER",!,"RADIOLOGY PROCEDURE file."
+3 IF $GET(RACPT)'=""
WRITE !!,"The CPT code for this procedure is ",RACPT,"."
+4 IF $GET(RACPT)=""
KILL DIR
SET DIR(0)="71,9^^"
SET DIR("A")="Enter the CPT code for this procedure, if the CPT code is known"
+5 IF $GET(RACPT)=""
KILL DIRUT,DIROUT,DUOUT
WRITE !
DO ^DIR
IF $GET(DIRUT)=1
GOTO END
+6 if X>0
SET $PIECE(^RAMRPF(71.11,RADA,0),U,9)=X
SET RACPT=X
+7 SET DA=RADA
DO MRPF^RANPRO5
SET RAGOLD=RAMATCH
+8 IF $DATA(DUOUT)!($GET(Y(0))="")!($GET(RANQUIT)=1)
WRITE !!,*7,"No MRPF match made.",!!
GOTO END
+9 IF $GET(RAPROIEN)'=""
IF ($GET(RANQUIT)'=1)
IF $DATA(^RAMIS(71,"MRPF",$SELECT($GET(RAPROIEN)'="":RAPROIEN,1:0)))
SET RAMTCH=1
DO MTCH^RANPROU2
+10 if $GET(RANQUIT)=1
GOTO END
+11 ; RA*5.0*138 corrected set value of 900, added check for active NTRT on 903 set
+12 IF Y(0)'["NONE LISTED"
SET DA=RADA
SET DIE="^RAMRPF(71.11,"
SET DIE(0)="L"
SET DR="900///"_RAPROIEN_";902///"_DT_";903///"_($SELECT($PIECE($GET(^RAMRPF(71.98,1,0)),U,10)'="Y":"",1:$PIECE($GET(^RAMRPF(71.99,RAPROIEN,0)),U,4)))
SET DA=RADA
DO ^DIE
Begin DoDot:1
+13 IF $GET(RAPROIEN)'=""
WRITE !?3,"You have mapped this procedure to "_$PIECE($GET(^RAMRPF(71.99,RAPROIEN,0)),U,1)
QUIT
End DoDot:1
+14 IF $GET(Y(0))["NONE LISTED"
Begin DoDot:1
+15 ; RA*5.0*138 change RAMIS(71 to RAMRPF(71.11
+16 SET DA=RADA
SET DIE="^RAMRPF(71.11,"
SET DIE(0)="L"
+17 SET DR="901///"
SET RA901=$SELECT($PIECE($GET(^RAMRPF(71.98,1,0)),U,10)="Y":"Y",1:"")
+18 SET DR=DR_RA901_";902///"_DT
DO ^DIE
+19 QUIT
End DoDot:1
+20 ; RA*5.0*138 remove hard set of indexes
+21 ;S $P(^RAMRPF(71.11,RADA,"NTRT"),U,3)=DT,^RAMRPF(71.11,"CREAT",DT,RADA)=""
+22 ;I $P($G(^RAMRPF(71.98,1,0)),U,10)'="Y" S $P(^RAMRPF(71.11,RADA,"NTRT"),U,3)=""
MSG ;SEND A MESSAGE TO GATEKEEPER
+1 IF $PIECE($GET(^RAMRPF(71.98,1,0)),U,10)'="Y"
QUIT RADA
+2 NEW XMSUB,XMY,XMTEXT,RATXT
if $PIECE($GET(^RAMRPF(71.11,RADA,"NTRT")),U,1)'=""
QUIT RADA
+3 SET XMSUB="NEW RADIOLOGY PROCEDURE"
+4 SET XMY(DUZ)=""
+5 IF $PIECE($GET(^RAMRPF(71.98,1,0)),U,2)'=""
SET XMY($PIECE(^RAMRPF(71.98,1,0),U,2))=""
+6 SET RATXT(1)="A new Radiology procedure has been entered."
+7 SET RATXT(3)="This procedure will be submitted for NTRT processing."
+8 SET RATXT(4)=" "
+9 SET RATXT(5)=" "
+10 ;S RATXT(7)=" "
+11 IF $GET(RA7111DA)=""
SET RA7111DA=$GET(^TMP("RA7111DA",$JOB))
+12 SET RATXT(7)="Procedure Name: "_$PIECE(^RAMRPF(71.11,RA7111DA,0),U,1)
+13 ;S RATXT(7)="Procedure Name: "_$P(^RAMRPF(71.11,1,0),U,1)
+14 SET RATXT(8)="CPT: "_$PIECE($GET(^RAMRPF(71.11,RADA,0)),U,9)
+15 SET XMTEXT="RATXT("
DO ^XMD
+16 IF $PIECE($GET(^RAMRPF(71.98,1,0)),U,10)'="Y"
QUIT RADA
+17 if $PIECE($GET(^RAMRPF(71.11,RADA,"NTRT")),U,1)'=""
QUIT RADA
+18 SET RANMSG=1
+19 GOTO END
MSG1 ;MESSAGE TO NTRT
+1 ;I $P($G(^RAMRPF(71.98,1,0)),U,10)'="Y" Q RADA
+2 IF $PIECE($GET(^RAMRPF(71.98,1,0)),U,10)'="Y"
QUIT
+3 ;N XMSUB,XMY,XMTEXT,RATXT Q:$P($G(^RAMIS(71,RADA,"NTRT")),U,1)'="" RADA
+4 NEW XMSUB,XMY,XMTEXT,RATXT,XMDUN,XMDUZ,XMZ,RAFAC,RAFN
+5 IF $PIECE($GET(^RAMIS(71,RADA,"NTRT")),U,1)'=""
QUIT
+6 SET RAFAC=$$KSP^XUPARAM("INST")
SET RAFAC=$$NS^XUAF4(RAFAC)
+7 ;S RAFN=$P(RAFAC,U,1),RAFAC=$P(RAFAC,U,2),$P(^RAMRPF(71.11,RADA,"NTRT"),U,2)="Y"
+8 NEW DA,DIE,DR
SET DIE="^RAMIS(71,"
SET DR="901///Y"
SET DA=RADA
DO ^DIE
KILL DA,DIE,DR
+9 SET RAFN=$PIECE(RAFAC,U,1)
SET RAFAC=$PIECE(RAFAC,U,2)
+10 ;S RAFN=$P(RAFAC,U,1),RAFAC=$P(RAFAC,U,2),$P(^RAMIS(71,RADA,"NTRT"),U,2)="Y"
+11 SET XMSUB="NEW RADIOLOGY PROCEDURE"
+12 SET XMY("G.RADIOLOGY NTRT@DOMAIN.EXT")=""
+13 SET XMY("G.RADNTRT")=""
+14 SET XMDUZ("G.RADNTRT")=""
+15 SET XMY(DUZ)=""
+16 IF $PIECE($GET(^RAMRPF(71.98,1,0)),U,2)'=""
SET XMY($PIECE(^RAMRPF(71.98,1,0),U,2))=""
+17 ;S XMY("G.RADIOLOGY NTRT@DOMAIN.EXT")=""
+18 SET RATXT(1)="A new Radiology procedure has been entered at "_RAFN
+19 SET RATXT(2)=" "
+20 SET RATXT(3)="Facility Name/number: "_RAFN_" / "_RAFAC
+21 SET RATXT(4)=" "
+22 IF $GET(RA7111DA)=""
SET RA7111DA=$GET(^TMP("RA7111DA",$JOB))
+23 SET RATXT(5)="Procedure name: "_$PIECE(^RAMIS(71,RADA,0),U,1)
+24 ;S RATXT(5)="Procedure name: "_$P(^RAMRPF(71.11,RA7111DA,0),U,1)
+25 ;S RATXT(5)="Procedure name: "_$P(^RAMRPF(71.11,1,0),U,1)
+26 SET RATXT(6)=" "
+27 SET RATXT(7)="CPT code: "_$PIECE($GET(^RAMIS(71,RADA,0)),U,9)
+28 ;S RATXT(7)="CPT code: "_$P($G(^RAMRPF(71.11,RADA,0)),U,9)
+29 SET RATXT(8)="Local IEN: "_RADA
+30 SET RATXT(9)="For questions or notification respond to: "_"G.RADNTRT@"_$$KSP^XUPARAM("WHERE")
+31 SET RATXT(10)="For NTRT results respond to: "_"S.RANEWPRO@"_$$KSP^XUPARAM("WHERE")
+32 ;I $P($G(^RAMRPF(71.98,1,0)),U,9)="Y" D XML G END
+33 SET $PIECE(^RAMIS(71,RADA,"NTRT"),U,4)=DT
+34 ;S $P(^RAMRPF(71.11,RADA,"NTRT"),U,4)=DT
+35 SET XMTEXT="RATXT("
DO ^XMD
+36 ;S $P(^RAMIS(71,RADA,"NTRT"),U,4)=DT
+37 IF $PIECE($GET(^RAMRPF(71.98,1,0)),U,9)="Y"
DO XML
+38 KILL XMSUB,XMY,XMTEXT,RATXT,XMDUN,XMDUZ,XMZ,RAFAC,RAFN
+39 QUIT
+40 ;
XML ; NTRT message for ISAAC
+1 ; Need P1 ISAAC SCHEMA NAME
+2 ; Need P2 ISAAC SCHEMA PATH
+3 ; get the schemea name and the schema path
+4 NEW P1,P2,A,C
+5 SET P1=$$GET1^DIQ(71.98,"1,",11.6)
+6 SET P2=$$GET1^DIQ(71.98,"1,",7)
+7 SET A=$TRANSLATE(P1,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+8 IF P1'=""&($EXTRACT(A,($LENGTH(A)-4),$LENGTH(A)))'=".XSD"
SET P1=P1_".XSD"
+9 ;<
IF P2'=""
Begin DoDot:1
+10 IF $EXTRACT(P2,1,2)'="//"
SET P2="//"_P2
+11 IF $EXTRACT(P2,$LENGTH(P2))="/"
SET P2=P2_$EXTRACT(P2,1,($LENGTH(P2)-1))
End DoDot:1
+12 SET A="uri:"_P2_P1
+13 SET XMSUB="NEW RADIOLOGY PROCEDURE"
+14 KILL RATXT
+15 SET RATXT(1)=$$XMLHDR^MXMLUTL()
+16 SET RATXT(2)="<DATAEXTRACTS xmlns="""_A_""" xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"""
+17 SET RATXT(3)=">"
+18 SET RATXT(4)="<RAD_NTRT>"
+19 SET RATXT(5)="<Facility_Name/number>"_RAFN_" / "_RAFAC_"</Facility_Name/number>"
+20 SET RATXT(6)="<Facility_Group_e-mail>"_"G.RADNTRT@"_$$KSP^XUPARAM("WHERE")_"</Facility_Group_e-mail>"
+21 SET RATXT(7)="<Procedure_name>"_RANM_"</Procedure_name>"
+22 SET RATXT(8)="<CPT_code>"_$PIECE($GET(^RAMIS(71,RADA,0)),U,9)_"</CPT_code>"
+23 ;S RATXT(8)="<CPT_code>"_$P($G(^RAMRPF(71.11,RADA,0)),U,9)_"</CPT_code>"
+24 SET RATXT(9)="<Local_IEN>"_RADA_"</Local_IEN>"
+25 SET RATXT(10)="<NTRT_results_response_e-mail>"_"S.RANEWPRO@"_$$KSP^XUPARAM("WHERE")_"</NTRT_results_response_e-mail>"
+26 SET RATXT(11)="</RAD_NTRT>"
+27 SET RATXT(12)="</DATAEXTRACTS>"
+28 SET RAXTMPNM=XMSUB
+29 ;D XMLSND^RAXMLSND(RAXTMPNM)
+30 NEW RADUZ,RA71IEN,RAS
+31 SET RADUZ=DUZ
SET RA71IEN=RADA
SET RAS=""
+32 DO EN^RAXMLSND
+33 KILL RADUZ,RA71IEN,RAS,RATXT
+34 QUIT
+35 ;
DEACT ;BLOCK INACTIVATION DATE
+1 QUIT
+2 IF $PIECE($GET(^RAMRPF(71.98,1,0)),U,3)'=""
Begin DoDot:1
+3 SET X1=DT
SET X2=$PIECE(^RAMRPF(71.98,1,0),U,3)
+4 DO C^%DTC
+5 SET ^RAMRPF(71.11,RADA,"I")=X
SET $PIECE(^RAMRPF(71.11,RADA,"NTRT"),U,2)="Y"
End DoDot:1
+6 QUIT
END ;KILL LOCAL VARIABLES AND END
+1 KILL RATXT,XMZ,XMDUN,XMDUZ,X,Y
+2 QUIT $GET(RANEWPRO)
+3 ;
MSGRAN(RADA) ; entry from RANPRO after file to 71 to send NTRT message
+1 GOTO MSG1
