RANEWPRO ;BPFO/CLT - NTRT RESPONSE ; 27 Jul 2016 11:51 AM
;;5.0;Radiology/Nuclear Medicine;**127**;Mar 16, 1998;Build 119
;
EN ;PRIMARY ENTRY POINT
N RAFIRST,RALINE,X,Y,RARESP,RAMSG,RATXT,XMY,XMTEXT,XMSUB,RAIEN,RAPRO,XMDUN,XMDUZ
S RAMSG=XMZ
S RAFIRST=$S($E(^XMB(3.9,RAMSG,2,1,0),1,2)="--":5,1:1)
S RALINE=RAFIRST
;
RESPONSE ;DETERMINE THE RESPONSE
S RARESP=$P(^XMB(3.9,RAMSG,2,RALINE,0)," ",1)
S X=RARESP X ^%ZOSF("UPPERCASE") S RARESP=Y
S RAIEN=$P(^XMB(3.9,RAMSG,2,(RALINE+3),0),":",2)
S RAPRO=$P(^XMB(3.9,RAMSG,2,(RALINE+2),0),":",2)
I RARESP="NEW" D
. S RATXT(1)="A new procedure has been added by NTRT to the MRPF."
. S RATXT(2)="This procedure will be included in the next MRPF release."
. S RATXT(3)="Contunue to use your created procedure, as is, until the new MRPF"
. S RATXT(4)="is received. Then this procedure can be matched.",RALINE=5
. I $G(RAIEN)'="" S $P(^RAMIS(71,RAIEN,"NTRT"),U,2)=""
. Q
I RARESP="MATCH" D
. S RATXT(1)="A match in MRPF has been found by NTRT. Please use"
. S RATXT(2)="the MRPF procedure "_$P(^XMB(3.9,RAMSG,2,(RALINE+1),0),"procedure ",2)_"."
. S RATXT(3)="Please map you new procedure to this MRPF entry.",RALINE=4
. I $G(RAIEN)'="" S $P(^RAMIS(71,RAIEN,"NTRT"),U,2)=""
. Q
I RARESP="NO" D
. S RATXT(1)="No LOINC can be found for the requested new procedure."
. S RATXT(2)="A request for a new LOINC has been submitted."
. S RATXT(3)="Continue to use your new procedure without matching until a new LOINC"
. S RATXT(4)="is received and distributed via a new MRPF release. Then this procedure"
. S RATXT(5)="can be matched.",RALINE=5
. Q
MSG ;CREATE A MESSAGE
S RATXT(RALINE+2)=" "
S RATXT(RALINE+3)="Local procedure: "_RAPRO
S RATXT(RALINE+4)="Local IEN: "_RAIEN
S XMSUB="NTRT RESPONSE"
S XMY("G.RADNTRT")="",XMTEXT="RATXT("
D ^XMD
END ;END ROUTINE
K XMZ
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRANEWPRO 1882 printed Dec 13, 2024@02:37:26 Page 2
RANEWPRO ;BPFO/CLT - NTRT RESPONSE ; 27 Jul 2016 11:51 AM
+1 ;;5.0;Radiology/Nuclear Medicine;**127**;Mar 16, 1998;Build 119
+2 ;
EN ;PRIMARY ENTRY POINT
+1 NEW RAFIRST,RALINE,X,Y,RARESP,RAMSG,RATXT,XMY,XMTEXT,XMSUB,RAIEN,RAPRO,XMDUN,XMDUZ
+2 SET RAMSG=XMZ
+3 SET RAFIRST=$SELECT($EXTRACT(^XMB(3.9,RAMSG,2,1,0),1,2)="--":5,1:1)
+4 SET RALINE=RAFIRST
+5 ;
RESPONSE ;DETERMINE THE RESPONSE
+1 SET RARESP=$PIECE(^XMB(3.9,RAMSG,2,RALINE,0)," ",1)
+2 SET X=RARESP
XECUTE ^%ZOSF("UPPERCASE")
SET RARESP=Y
+3 SET RAIEN=$PIECE(^XMB(3.9,RAMSG,2,(RALINE+3),0),":",2)
+4 SET RAPRO=$PIECE(^XMB(3.9,RAMSG,2,(RALINE+2),0),":",2)
+5 IF RARESP="NEW"
Begin DoDot:1
+6 SET RATXT(1)="A new procedure has been added by NTRT to the MRPF."
+7 SET RATXT(2)="This procedure will be included in the next MRPF release."
+8 SET RATXT(3)="Contunue to use your created procedure, as is, until the new MRPF"
+9 SET RATXT(4)="is received. Then this procedure can be matched."
SET RALINE=5
+10 IF $GET(RAIEN)'=""
SET $PIECE(^RAMIS(71,RAIEN,"NTRT"),U,2)=""
+11 QUIT
End DoDot:1
+12 IF RARESP="MATCH"
Begin DoDot:1
+13 SET RATXT(1)="A match in MRPF has been found by NTRT. Please use"
+14 SET RATXT(2)="the MRPF procedure "_$PIECE(^XMB(3.9,RAMSG,2,(RALINE+1),0),"procedure ",2)_"."
+15 SET RATXT(3)="Please map you new procedure to this MRPF entry."
SET RALINE=4
+16 IF $GET(RAIEN)'=""
SET $PIECE(^RAMIS(71,RAIEN,"NTRT"),U,2)=""
+17 QUIT
End DoDot:1
+18 IF RARESP="NO"
Begin DoDot:1
+19 SET RATXT(1)="No LOINC can be found for the requested new procedure."
+20 SET RATXT(2)="A request for a new LOINC has been submitted."
+21 SET RATXT(3)="Continue to use your new procedure without matching until a new LOINC"
+22 SET RATXT(4)="is received and distributed via a new MRPF release. Then this procedure"
+23 SET RATXT(5)="can be matched."
SET RALINE=5
+24 QUIT
End DoDot:1
MSG ;CREATE A MESSAGE
+1 SET RATXT(RALINE+2)=" "
+2 SET RATXT(RALINE+3)="Local procedure: "_RAPRO
+3 SET RATXT(RALINE+4)="Local IEN: "_RAIEN
+4 SET XMSUB="NTRT RESPONSE"
+5 SET XMY("G.RADNTRT")=""
SET XMTEXT="RATXT("
+6 DO ^XMD
END ;END ROUTINE
+1 KILL XMZ
+2 QUIT
