RAO7UTL ;HISC/GJC,SS-Utilities for HL7 messages. ; 20 Apr 2011 7:31 PM
;;5.0;Radiology/Nuclear Medicine;**18,45,57,82,1003**;Nov 01, 2010;Build 3
;modified by SS JUN 19,2000 for P18
EN1 ; Entry point to define some basic HL7 variables
N I S RAHLFS="|",RAECH="^~\&"
S $P(RAHLFS(0),RAHLFS,51)=""
F I=1:1:$L(RAECH) S RAECH(I)=$E(RAECH,I)
Q
;
CMEDIA(IEN,RAPTYPE) ;Called from RAO7MFN when a procedure is updated
;Input: IEN=ien of proc. in file 71
; RAPTYPE=procedure type; broad, parent, series, or detailed.
;Return: J=a string with some combination of the following indicators:
;I for Iodinated ionic, N for Iodinated non-ionic, L for Gadolinium
;C for Oral Cholecystographic, G for Gastrografin, B for Barium or
;NULL if none of the indicators apply to this procedure.
;
;'Broad' procedures have no contrast media definition, return null
Q:RAPTYPE="B" ""
;if 'detailed' or 'series' & no contrast media data return null
I RAPTYPE'="P",'($O(^RAMIS(71,IEN,"CM",0))) Q ""
NEW I,INA,J S J=""
I RAPTYPE="P" D
.S I=0 F S I=$O(^RAMIS(71,IEN,4,I)) Q:'I D
..S I(0)=+$G(^RAMIS(71,IEN,4,I,0)) Q:'I(0)
..S INA=$P($G(^RAMIS(71,I(0),"I")),"^")
..S INA=$S(INA="":1,INA>DT:1,1:0)
..D:INA NONPAR(I(0))
..Q
.Q
E D NONPAR(IEN)
Q J
;
NONPAR(IEN) ;obtain contrast media data for a 'detailed' or 'series' proc
; Input: IEN=ien of the non-parent, non-broad procedure
;Return: J=data string (return)
;variable definition: I=ien of sub-file rec
NEW H,I S I=0
F S I=$O(^RAMIS(71,IEN,"CM",I)) Q:I'>0 D
.S H=$P($G(^RAMIS(71,IEN,"CM",I,0)),U) Q:H=""
.S:J'[H J=J_H
.Q
Q
;
MSH(X) ; Set up the 'MSH' segment.
; 'X' is passed in and identifies the message type.
S:X']"" X="Message Type Error"
Q "MSH"_RAHLFS_RAECH_RAHLFS_"RADIOLOGY"_RAHLFS_$P($G(^DIC(4,+$G(DUZ(2)),99)),"^")_$$STR(3)_$$HLDATE^HLFNC($$NOW^XLFDT(),"TS")_$$STR(2)_X
;
MSA(X,Y) ; Set up the 'MSA' segment. P18
; 'X' is passed in and identifies the message ID.
; 'Y' is acknowledgement code
S:X']"" X="Message ID Error"
Q "MSA"_RAHLFS_Y_RAHLFS_$E(X,1,20)_$$STR(4)
MFI(X) ; Set up the 'MFI' segment
S @(RAVAR_RACNT_")")="MFI"_RAHLFS_RAFNUM
S @(RAVAR_RACNT_")")=@(RAVAR_RACNT_")")_RAECH(1)_RAFNAME_RAECH(1)
S @(RAVAR_RACNT_")")=@(RAVAR_RACNT_")")_"99DD"_RAHLFS_RAHLFS_X ;P18
S @(RAVAR_RACNT_")")=@(RAVAR_RACNT_")")_RAHLFS_RAHLFS_RAHLFS_"ER"
X RAINCR ; increment counter
Q
PID(Y) ; Create 'pid' segment
Q "PID"_$$STR(3)_+$P(Y,"^")_$$STR(2)_$P($G(^DPT(+$P(Y,"^"),0)),"^")
;
PV1(Y) ; Create 'pv1' segment
;Input: Y=zero node of the RAD/NUC MED ORDERS (#75.1) file
N DFN,RA,RARMBED,RAWARD,VAIP,RAPF
S DFN=+$P(Y,"^"),VAIP("D")=$P(Y,"^",21)
S RA("PV1",2)="O",RA("PV1",3)=+$P(Y,"^",22)
D IN5^VADPT S RAWARD=$G(VAIP(5)),RARMBED=$G(VAIP(6))
I RAWARD]"" D
. S RA("PV1",2)="I",RAWARD(44)=$P($G(^DIC(42,+RAWARD,44)),"^")
. S RA("PV1",3)=+RAWARD(44)_U_$P(RARMBED,"^",2)
. Q
S RAPF="PV1"_$$STR(2)_RA("PV1",2)_RAHLFS_RA("PV1",3)_$$STR(16) ;_"Visit #" was truncated for P18 ? Req 4
;IHS/BJI/DAY - Patch 1003 - Comment out call to VA's IBB package
;D PV1^RABWIBB
;End Patch
; pv1^RABWIBB will redefine RAPF if the PFSS switch is on and there's a valid PFSS Account Reference
; Otherwise, RAPF won't be changed
K RACCOUNT ; this variable was set earlier in FB^RABWIBB
Q RAPF
;
PURGE K RAHLFS,RACNT,RAECH,RAFNAME,RAFNUM,RAINCR,RASUB,RATSTMP,RAVAR,RAXIT
PURGE1 ; kill only whole file update variables
K RA71,RA713,RACMCODE,RACMNOR,RACOST,RACPT,RAIEN71,RAIMGAB,RAMFE,RAMULT
K RAPHYAP,RAPRCTY,RAXT71
Q
DIAG(X,Y,Z) ; Pass back an "A" if any Dx code has 'Yes' in the 'Generate
; Abnormal Alert' field.
N A,AAH,RA7003,RA783 S AAH=""
S RA7003=$G(^RADPT(X,"DT",Y,"P",Z,0)),RA7003(13)=+$P(RA7003,"^",13)
S RA783(0)=$G(^RA(78.3,RA7003(13),0))
S RA783(4)=$$UP^XLFSTR($P(RA783(0),"^",4))
S:RA783(4)="Y" AAH="A"
Q:AAH]"" AAH
S A=0 F S A=$O(^RADPT(X,"DT",Y,"P",Z,"DX",A)) Q:A'>0 D Q:AAH]""
. S RA783=+$G(^RADPT(X,"DT",Y,"P",Z,"DX",A,0))
. S RA783(0)=$G(^RA(78.3,RA783,0))
. S RA783(4)=$$UP^XLFSTR($P(RA783(0),"^",4))
. I RA783(4)="Y" S AAH="A"
. Q
Q AAH
PROCNDE(X) ; Check if the procedure has both an I-Type & Proc. Type
; assigned. Pass back '1' if either the I-Type -or- Proc. Type
; data is missing. '0' if everything is ok.
I $P(X(0),U,6)]"",($P(X(0),U,12)]"") Q 0
Q 1
STR(X) ; Pass back a predetermined # of '|' or other field separator
Q:$G(RAHLFS(0))']""!(+X=0) "" ; Quit if parent string i.e, 'RAHLFS(0)'
; does not exist or +X evaluates to null.
;
S:X<0 X=$$ABS^XLFMTH(X) ; If passed in negative, take absolute
; value. Quit if 'X' is greater than the
; length of our parent string.
;
S:X["." X=X\1 ; If a non-integer, remove mantissa.
;
Q:X>($L(RAHLFS(0))) "" ; If parameter greater than length of
; string, pass back null.
Q $E(RAHLFS(0),1,X)
;
CHKUSR(RADUZ) ; Check user status to 'DC' an order.
; pass back '0' if non-active Rad/Nuc Med user
; pass back '1' if active Rad/Nuc Med user
N RAINADT S RAINADT=+$P($G(^VA(200,RADUZ,"PS")),"^",4) ;inactivation DT
Q $S('($D(RADUZ)#2):0,'$D(^VA(200,RADUZ,0)):0,'$D(^("RAC")):0,'RAINADT:1,'$D(DT):0,DT'>RAINADT:1,1:0)
;
ERR(RATXT,RAMSG,RAVAR) ; Call CPRS utility to log 'soft' errors.
; Input: RATXT-text description of the error
; RAMSG-HL7 message array
; RAVAR-variables to be saved off
D EN^ORERR(RATXT,.RAMSG,.RAVAR)
Q
;
MSG(RAPROTO,RAMSG) ; ship HL7 messages to CPRS from this entry point
; input: RAPROTO - protocol to execute
; RAMSG - message (in HL7 format)
D MSG^XQOR(RAPROTO,.RAMSG)
Q
;
UPDATP(RAY) ;update the parent procedure when a descendent is
;updated. Called from RAMAIN2 (procedure entry/edit)
;input: RAY=ien of desc.^name of desc. (if existing record)
; RAY=ien of desc.^name of desc.^1 (if new record)
W !!,$P(RAY,U,2)_" is a descendent procedure, updating parent(s)..."
N RAPIEN,RAQUIT S (RAPIEN,RAQUIT)=0
F S RAPIEN=$O(^RAMIS(71,"ADESC",+RAY,RAPIEN)) Q:'RAPIEN D Q:RAQUIT
.S RAPIEN(0)=$G(^RAMIS(71,RAPIEN,0))
.W !?2,"Updating parent: "_$E($P(RAPIEN(0),U),1,50)
.S RAPIEN("I")=$P($G(^RAMIS(71,RAPIEN,"I")),"^")
.S RAPIEN("S")=$S(RAPIEN("I")="":1,RAPIEN("I")>DT:1,1:0)
.L +^RAMIS(71,RAPIEN):300
.I '$T S RAQUIT=1 D Q
..W !?2,"Parent Procedure: "_$E($P(RAPIEN(0),U),1,50)
..W !?2,"being edited by another user, try again later!",$C(7)
..Q
.D PROC^RAO7MFN(0,71,RAPIEN("S")_"^"_RAPIEN("S"),RAPIEN)
.L -^RAMIS(71,RAPIEN)
.Q
Q
;----------------------------
;called from
;-Case # edit START1+16^RAEDCN
;-Edit by patient
;-Tracking
;Saves proc ien before editing, locate the exam by patient, datetime and caseN
SVBEFOR(RAPATN,RAINVDT,RACIEN) ;P18;send radfn,radti,racni (instead of racn and new sequencing of params
; RAPRIEN() holds "before" values
N RADATA,RAX,RA0,RA1,RA2,RA3
S RADATA=$G(^RADPT(RAPATN,"DT",RAINVDT,"P",RACIEN,0))
Q:RADATA="" ;failure
; don't check parent here, since still need compare Req Phys & Proc Mods
S RAPRIEN=$P(RADATA,"^",2) ; procedure ien
S RAPRIEN(1)=RAPATN ; dfn
S RAPRIEN(2)=RAINVDT ; inverse date exm
S RAPRIEN(3)=RACIEN ; case ien
S RAPRIEN(4)=$P(RADATA,"^",14) ; req phy
D STR70^RAUTL10(.RAX,RAPATN,RAINVDT,RACIEN)
S RAPRIEN(5)=RAX ; string of proc mods
; send "XX" if diffcs in Req.Phy &/or Proc Mods
; Next lines are for RA*5*82
; Save CPT modifiers before editing
S RAX=0 K RAPRIEN("CMOD")
F S RAX=$O(^RADPT(RAPATN,"DT",RAINVDT,"P",RACIEN,"CMOD",RAX)) Q:'RAX S RAPRIEN("CMOD",RAX)=+$G(^(RAX,0))
; Save Tech comments before editing
S RAX=0 K RAPRIEN("TCOM")
F S RAX=$O(^RADPT(RAPATN,"DT",RAINVDT,"P",RACIEN,"L",RAX)) Q:'RAX S RAPRIEN("TCOM",RAX)=$G(^(RAX,"TCOM"))
Q ;OK
RAO7UTL ;HISC/GJC,SS-Utilities for HL7 messages. ; 20 Apr 2011 7:31 PM
+1 ;;5.0;Radiology/Nuclear Medicine;**18,45,57,82,1003**;Nov 01, 2010;Build 3
+2 ;modified by SS JUN 19,2000 for P18
EN1 ; Entry point to define some basic HL7 variables
+1 NEW I
SET RAHLFS="|"
SET RAECH="^~\&"
+2 SET $PIECE(RAHLFS(0),RAHLFS,51)=""
+3 FOR I=1:1:$LENGTH(RAECH)
SET RAECH(I)=$EXTRACT(RAECH,I)
+4 QUIT
+5 ;
CMEDIA(IEN,RAPTYPE) ;Called from RAO7MFN when a procedure is updated
+1 ;Input: IEN=ien of proc. in file 71
+2 ; RAPTYPE=procedure type; broad, parent, series, or detailed.
+3 ;Return: J=a string with some combination of the following indicators:
+4 ;I for Iodinated ionic, N for Iodinated non-ionic, L for Gadolinium
+5 ;C for Oral Cholecystographic, G for Gastrografin, B for Barium or
+6 ;NULL if none of the indicators apply to this procedure.
+7 ;
+8 ;'Broad' procedures have no contrast media definition, return null
+9 IF RAPTYPE="B"
QUIT ""
+10 ;if 'detailed' or 'series' & no contrast media data return null
+11 IF RAPTYPE'="P"
IF '($ORDER(^RAMIS(71,IEN,"CM",0)))
QUIT ""
+12 NEW I,INA,J
SET J=""
+13 IF RAPTYPE="P"
Begin DoDot:1
+14 SET I=0
FOR
SET I=$ORDER(^RAMIS(71,IEN,4,I))
IF 'I
QUIT
Begin DoDot:2
+15 SET I(0)=+$GET(^RAMIS(71,IEN,4,I,0))
IF 'I(0)
QUIT
+16 SET INA=$PIECE($GET(^RAMIS(71,I(0),"I")),"^")
+17 SET INA=$SELECT(INA="":1,INA>DT:1,1:0)
+18 IF INA
DO NONPAR(I(0))
+19 QUIT
End DoDot:2
+20 QUIT
End DoDot:1
+21 IF '$TEST
DO NONPAR(IEN)
+22 QUIT J
+23 ;
NONPAR(IEN) ;obtain contrast media data for a 'detailed' or 'series' proc
+1 ; Input: IEN=ien of the non-parent, non-broad procedure
+2 ;Return: J=data string (return)
+3 ;variable definition: I=ien of sub-file rec
+4 NEW H,I
SET I=0
+5 FOR
SET I=$ORDER(^RAMIS(71,IEN,"CM",I))
IF I'>0
QUIT
Begin DoDot:1
+6 SET H=$PIECE($GET(^RAMIS(71,IEN,"CM",I,0)),U)
IF H=""
QUIT
+7 IF J'[H
SET J=J_H
+8 QUIT
End DoDot:1
+9 QUIT
+10 ;
MSH(X) ; Set up the 'MSH' segment.
+1 ; 'X' is passed in and identifies the message type.
+2 IF X']""
SET X="Message Type Error"
+3 QUIT "MSH"_RAHLFS_RAECH_RAHLFS_"RADIOLOGY"_RAHLFS_$PIECE($GET(^DIC(4,+$GET(DUZ(2)),99)),"^")_$$STR(3)_$$HLDATE^HLFNC($$NOW^XLFDT(),"TS")_$$STR(2)_X
+4 ;
MSA(X,Y) ; Set up the 'MSA' segment. P18
+1 ; 'X' is passed in and identifies the message ID.
+2 ; 'Y' is acknowledgement code
+3 IF X']""
SET X="Message ID Error"
+4 QUIT "MSA"_RAHLFS_Y_RAHLFS_$EXTRACT(X,1,20)_$$STR(4)
MFI(X) ; Set up the 'MFI' segment
+1 SET @(RAVAR_RACNT_")")="MFI"_RAHLFS_RAFNUM
+2 SET @(RAVAR_RACNT_")")=@(RAVAR_RACNT_")")_RAECH(1)_RAFNAME_RAECH(1)
+3 ;P18
SET @(RAVAR_RACNT_")")=@(RAVAR_RACNT_")")_"99DD"_RAHLFS_RAHLFS_X
+4 SET @(RAVAR_RACNT_")")=@(RAVAR_RACNT_")")_RAHLFS_RAHLFS_RAHLFS_"ER"
+5 ; increment counter
XECUTE RAINCR
+6 QUIT
PID(Y) ; Create 'pid' segment
+1 QUIT "PID"_$$STR(3)_+$PIECE(Y,"^")_$$STR(2)_$PIECE($GET(^DPT(+$PIECE(Y,"^"),0)),"^")
+2 ;
PV1(Y) ; Create 'pv1' segment
+1 ;Input: Y=zero node of the RAD/NUC MED ORDERS (#75.1) file
+2 NEW DFN,RA,RARMBED,RAWARD,VAIP,RAPF
+3 SET DFN=+$PIECE(Y,"^")
SET VAIP("D")=$PIECE(Y,"^",21)
+4 SET RA("PV1",2)="O"
SET RA("PV1",3)=+$PIECE(Y,"^",22)
+5 DO IN5^VADPT
SET RAWARD=$GET(VAIP(5))
SET RARMBED=$GET(VAIP(6))
+6 IF RAWARD]""
Begin DoDot:1
+7 SET RA("PV1",2)="I"
SET RAWARD(44)=$PIECE($GET(^DIC(42,+RAWARD,44)),"^")
+8 SET RA("PV1",3)=+RAWARD(44)_U_$PIECE(RARMBED,"^",2)
+9 QUIT
End DoDot:1
+10 ;_"Visit #" was truncated for P18 ? Req 4
SET RAPF="PV1"_$$STR(2)_RA("PV1",2)_RAHLFS_RA("PV1",3)_$$STR(16)
+11 ;IHS/BJI/DAY - Patch 1003 - Comment out call to VA's IBB package
+12 ;D PV1^RABWIBB
+13 ;End Patch
+14 ; pv1^RABWIBB will redefine RAPF if the PFSS switch is on and there's a valid PFSS Account Reference
+15 ; Otherwise, RAPF won't be changed
+16 ; this variable was set earlier in FB^RABWIBB
KILL RACCOUNT
+17 QUIT RAPF
+18 ;
PURGE KILL RAHLFS,RACNT,RAECH,RAFNAME,RAFNUM,RAINCR,RASUB,RATSTMP,RAVAR,RAXIT
PURGE1 ; kill only whole file update variables
+1 KILL RA71,RA713,RACMCODE,RACMNOR,RACOST,RACPT,RAIEN71,RAIMGAB,RAMFE,RAMULT
+2 KILL RAPHYAP,RAPRCTY,RAXT71
+3 QUIT
DIAG(X,Y,Z) ; Pass back an "A" if any Dx code has 'Yes' in the 'Generate
+1 ; Abnormal Alert' field.
+2 NEW A,AAH,RA7003,RA783
SET AAH=""
+3 SET RA7003=$GET(^RADPT(X,"DT",Y,"P",Z,0))
SET RA7003(13)=+$PIECE(RA7003,"^",13)
+4 SET RA783(0)=$GET(^RA(78.3,RA7003(13),0))
+5 SET RA783(4)=$$UP^XLFSTR($PIECE(RA783(0),"^",4))
+6 IF RA783(4)="Y"
SET AAH="A"
+7 IF AAH]""
QUIT AAH
+8 SET A=0
FOR
SET A=$ORDER(^RADPT(X,"DT",Y,"P",Z,"DX",A))
IF A'>0
QUIT
Begin DoDot:1
+9 SET RA783=+$GET(^RADPT(X,"DT",Y,"P",Z,"DX",A,0))
+10 SET RA783(0)=$GET(^RA(78.3,RA783,0))
+11 SET RA783(4)=$$UP^XLFSTR($PIECE(RA783(0),"^",4))
+12 IF RA783(4)="Y"
SET AAH="A"
+13 QUIT
End DoDot:1
IF AAH]""
QUIT
+14 QUIT AAH
PROCNDE(X) ; Check if the procedure has both an I-Type & Proc. Type
+1 ; assigned. Pass back '1' if either the I-Type -or- Proc. Type
+2 ; data is missing. '0' if everything is ok.
+3 IF $PIECE(X(0),U,6)]""
IF ($PIECE(X(0),U,12)]"")
QUIT 0
+4 QUIT 1
STR(X) ; Pass back a predetermined # of '|' or other field separator
+1 ; Quit if parent string i.e, 'RAHLFS(0)'
IF $GET(RAHLFS(0))']""!(+X=0)
QUIT ""
+2 ; does not exist or +X evaluates to null.
+3 ;
+4 ; If passed in negative, take absolute
IF X<0
SET X=$$ABS^XLFMTH(X)
+5 ; value. Quit if 'X' is greater than the
+6 ; length of our parent string.
+7 ;
+8 ; If a non-integer, remove mantissa.
IF X["."
SET X=X\1
+9 ;
+10 ; If parameter greater than length of
IF X>($LENGTH(RAHLFS(0)))
QUIT ""
+11 ; string, pass back null.
+12 QUIT $EXTRACT(RAHLFS(0),1,X)
+13 ;
CHKUSR(RADUZ) ; Check user status to 'DC' an order.
+1 ; pass back '0' if non-active Rad/Nuc Med user
+2 ; pass back '1' if active Rad/Nuc Med user
+3 ;inactivation DT
NEW RAINADT
SET RAINADT=+$PIECE($GET(^VA(200,RADUZ,"PS")),"^",4)
+4 QUIT $SELECT('($DATA(RADUZ)#2):0,'$DATA(^VA(200,RADUZ,0)):0,'$DATA(^("RAC")):0,'RAINADT:1,'$DATA(DT):0,DT'>RAINADT:1,1:0)
+5 ;
ERR(RATXT,RAMSG,RAVAR) ; Call CPRS utility to log 'soft' errors.
+1 ; Input: RATXT-text description of the error
+2 ; RAMSG-HL7 message array
+3 ; RAVAR-variables to be saved off
+4 DO EN^ORERR(RATXT,.RAMSG,.RAVAR)
+5 QUIT
+6 ;
MSG(RAPROTO,RAMSG) ; ship HL7 messages to CPRS from this entry point
+1 ; input: RAPROTO - protocol to execute
+2 ; RAMSG - message (in HL7 format)
+3 DO MSG^XQOR(RAPROTO,.RAMSG)
+4 QUIT
+5 ;
UPDATP(RAY) ;update the parent procedure when a descendent is
+1 ;updated. Called from RAMAIN2 (procedure entry/edit)
+2 ;input: RAY=ien of desc.^name of desc. (if existing record)
+3 ; RAY=ien of desc.^name of desc.^1 (if new record)
+4 WRITE !!,$PIECE(RAY,U,2)_" is a descendent procedure, updating parent(s)..."
+5 NEW RAPIEN,RAQUIT
SET (RAPIEN,RAQUIT)=0
+6 FOR
SET RAPIEN=$ORDER(^RAMIS(71,"ADESC",+RAY,RAPIEN))
IF 'RAPIEN
QUIT
Begin DoDot:1
+7 SET RAPIEN(0)=$GET(^RAMIS(71,RAPIEN,0))
+8 WRITE !?2,"Updating parent: "_$EXTRACT($PIECE(RAPIEN(0),U),1,50)
+9 SET RAPIEN("I")=$PIECE($GET(^RAMIS(71,RAPIEN,"I")),"^")
+10 SET RAPIEN("S")=$SELECT(RAPIEN("I")="":1,RAPIEN("I")>DT:1,1:0)
+11 LOCK +^RAMIS(71,RAPIEN):300
+12 IF '$TEST
SET RAQUIT=1
Begin DoDot:2
+13 WRITE !?2,"Parent Procedure: "_$EXTRACT($PIECE(RAPIEN(0),U),1,50)
+14 WRITE !?2,"being edited by another user, try again later!",$CHAR(7)
+15 QUIT
End DoDot:2
QUIT
+16 DO PROC^RAO7MFN(0,71,RAPIEN("S")_"^"_RAPIEN("S"),RAPIEN)
+17 LOCK -^RAMIS(71,RAPIEN)
+18 QUIT
End DoDot:1
IF RAQUIT
QUIT
+19 QUIT
+20 ;----------------------------
+21 ;called from
+22 ;-Case # edit START1+16^RAEDCN
+23 ;-Edit by patient
+24 ;-Tracking
+25 ;Saves proc ien before editing, locate the exam by patient, datetime and caseN
SVBEFOR(RAPATN,RAINVDT,RACIEN) ;P18;send radfn,radti,racni (instead of racn and new sequencing of params
+1 ; RAPRIEN() holds "before" values
+2 NEW RADATA,RAX,RA0,RA1,RA2,RA3
+3 SET RADATA=$GET(^RADPT(RAPATN,"DT",RAINVDT,"P",RACIEN,0))
+4 ;failure
IF RADATA=""
QUIT
+5 ; don't check parent here, since still need compare Req Phys & Proc Mods
+6 ; procedure ien
SET RAPRIEN=$PIECE(RADATA,"^",2)
+7 ; dfn
SET RAPRIEN(1)=RAPATN
+8 ; inverse date exm
SET RAPRIEN(2)=RAINVDT
+9 ; case ien
SET RAPRIEN(3)=RACIEN
+10 ; req phy
SET RAPRIEN(4)=$PIECE(RADATA,"^",14)
+11 DO STR70^RAUTL10(.RAX,RAPATN,RAINVDT,RACIEN)
+12 ; string of proc mods
SET RAPRIEN(5)=RAX
+13 ; send "XX" if diffcs in Req.Phy &/or Proc Mods
+14 ; Next lines are for RA*5*82
+15 ; Save CPT modifiers before editing
+16 SET RAX=0
KILL RAPRIEN("CMOD")
+17 FOR
SET RAX=$ORDER(^RADPT(RAPATN,"DT",RAINVDT,"P",RACIEN,"CMOD",RAX))
IF 'RAX
QUIT
SET RAPRIEN("CMOD",RAX)=+$GET(^(RAX,0))
+18 ; Save Tech comments before editing
+19 SET RAX=0
KILL RAPRIEN("TCOM")
+20 FOR
SET RAX=$ORDER(^RADPT(RAPATN,"DT",RAINVDT,"P",RACIEN,"L",RAX))
IF 'RAX
QUIT
SET RAPRIEN("TCOM",RAX)=$GET(^(RAX,"TCOM"))
+21 ;OK
QUIT
