RAO7NEW ;HISC/FPT - Create entry in OE/RR Order file (100) ; 06 Oct 2013 11:11 AM
;;5.0;Radiology/Nuclear Medicine;**5,10,18,41,75,1005**;Mar 16, 1998 ;Build 13
;
; This routine invokes IA #1300-A, #2083, #10082
;last modification for P18 by SS July 5,2000
EN1(RAOIFN) ; 'RAOIFN' is the ien in file 75.1
; In RA*5.0*18 this call is used when procedure CHANGED during registration, adding to visit and editing
; New vars & define the following variables: RAECH, RAECH array & RAHLFS
N A,B,DFN,RA,RA0,RACNT,RACPT,RADFN,RAECH,RAHL7DT,RAHLFS,RALOC,RANATURE
N RAPRIOR,RAPROC,RAR,RARMBED,RATAB,RAVAR,RAWARD,RAXIT
N RAORORDN,RAD70SB,RAORDCTR ;P18, OR Order No, "DT" of #70, Orderctrl,subscr of 70
N RABWDX,RABWDX1 ; Billing Awareness Project.
S RAORORDN="",RAD70SB=0,RAORDCTR="SN" ;P18, these sets mean that it's request mode (not the case, when procedure changed during registering or editing)
I $D(RAREGMOD) S RAORORDN=$P(^RAO(75.1,RAOIFN,0),"^",7)_"^OR",RAORDCTR="XX" ;P18,if register mode (see RAREG2 for EN1^RAO7XX)
S RATAB=1 D EN1^RAO7UTL
S RA0=$G(^RAO(75.1,RAOIFN,0)) Q:RA0']""
SS2 I RAORDCTR="XX" D UPDTRA0^RAO7XX ;P18, update RA0 with #70 inf, sets RAD70SB, that provide D2^D3 of #70
S RADFN=+RA0,RAR=$G(^RAO(75.1,RAOIFN,"R"))
SS3 I RAORDCTR="XX",RAD70SB'=0 S RAR=$G(^RADPT(+RA0,"DT",$P(RAD70SB,"^",1),"P",$P(RAD70SB,"^",2),"R")) ;P18
;
;*Billing Awarenes Project:
; Retrieve Ordering ICD Dx data to Send to CPRS.
D SENDCPRS^RABWORD1(RAOIFN)
;*
S RAVAR="RATMP(",RAVARBLE="RATMP"
; msh
S @(RAVAR_RATAB_")")=$$MSH^RAO7UTL("ORM^O01") ;P18
; pid
S RATAB=RATAB+1,@(RAVAR_RATAB_")")=$$PID^RAO7UTL(RA0)
; pv1
S RATAB=RATAB+1,@(RAVAR_RATAB_")")=$$PV1^RAO7UTL(RA0)
K RA("PV1"),VAIP,RABWVSIT
; orc
S RAHL7DT=$$HLDATE^HLFNC($P(RA0,U,21),"TS"),RAPRIOR=$P(RA0,U,6)
S RAPRIOR=$S(RAPRIOR=1:"S",RAPRIOR=2:"A",RAPRIOR=9:"R",1:"")
S RA("ORC",7)="^^^"_RAHL7DT_"^^"_RAPRIOR
S RA("ORC",10)=$P(RA0,U,15),RA("ORC",12)=$P(RA0,U,14)
S RA("ORC",11)=$P(RA0,U,8) ;approving radiologist
S RA("ORC",15)=$$HLDATE^HLFNC($P(RA0,"^",16),"TS")
S RANATURE="" I $L($P(RA0,"^",26)) S RANATURE=$$UP^XLFSTR($P(RA0,"^",26))_RAECH(1)_$$EXTERNAL^DILFD(75.1,26,"",$P(RA0,"^",26))
F I=1,2 I '$L($P(RANATURE,"^",I)) S RANATURE="S"_RAECH(1)_"SERVICE CORRECTION"
K I S RA("ORC",16)=RANATURE_RAECH(1)_"99ORN"_RAECH(1)_RAECH(1)_RAECH(1)
S RATAB=RATAB+1
;P18, next line was modified
SS4 S @(RAVAR_RATAB_")")="ORC"_RAHLFS_RAORDCTR_RAHLFS_RAORORDN_RAHLFS_RAOIFN_RAECH(1)_"RA"_$$STR^RAO7UTL(4)_RA("ORC",7)_$$STR^RAO7UTL(3)_RA("ORC",10)_RAHLFS_RA("ORC",11)_RAHLFS_RA("ORC",12)_$$STR^RAO7UTL(3)_RA("ORC",15)_RAHLFS_RA("ORC",16)
K RA("ORC")
; obr
S RAPROC(0)=$G(^RAMIS(71,+$P(RA0,U,2),0)),RAPROC(9)=+$P(RAPROC(0),U,9)
S RACPT(0)=$$NAMCODE^RACPTMSC(RAPROC(9),DT)
S RA("OBR",4)=$P(RACPT(0),U)_U_$P(RACPT(0),U,2)_U_"CPT4"_U_+$P(RA0,U,2)_U_$P(RAPROC(0),U)_"^99RAP"
S RA("OBR",12)=""
S:$P(RA0,U,24)]""&("Yy"[$P(RA0,U,24)) RA("OBR",12)="isolation"
S RA("OBR",18)=""
SS5 I RAORDCTR="XX",RAD70SB'=0 D MODIF70^RAO7XX($P(RAD70SB,"^",1),$P(RAD70SB,"^",2)) G CONTIN ;P18 by SS
I $O(^RAO(75.1,RAOIFN,"M",0)) D
. S (A,RAXIT)=0
. F S A=$O(^RAO(75.1,RAOIFN,"M",A)) Q:A'>0 D Q:RAXIT
.. S B(0)=$G(^RAO(75.1,RAOIFN,"M",A,0))
.. S B(1)=$P($G(^RAMIS(71.2,+B(0),0)),U)
.. I $L(RA("OBR",18))+$L(B(1))>60 S RAXIT=1 Q
.. S RA("OBR",18)=$G(RA("OBR",18))_B(1)_RAECH(2)
.. Q
. S RA("OBR",18)=$P(RA("OBR",18),RAECH(2),1,$L(RA("OBR",18),RAECH(2))-1)
. Q
CONTIN S RALOC(0)=$G(^RA(79.1,+$P(RA0,U,20),0))
S RA("OBR",19)=+$P(RA0,U,20)_U_$P($G(^SC(+RALOC(0),0)),U)
S:+RA("OBR",19)'>0 RA("OBR",19)=""
S RA("OBR",30)=$S($P(RA0,U,19)="":"","Aa"[$P(RA0,U,19):"WALK","Pp"[$P(RA0,U,19):"PORT","Ss"[$P(RA0,U,19):"CART","Ww"[$P(RA0,U,19):"WHLC",1:"")
;----- P75 REASON FOR STUDY OBR-31.2 -----
S (RAREASDY,RA("OBR",31))=RAECH(1)_$P($G(^RAO(75.1,RAOIFN,.1)),U)
S RA("OBRZ")="OBR"_$$STR^RAO7UTL(4)_RA("OBR",4)_$$STR^RAO7UTL(8)_RA("OBR",12)_$$STR^RAO7UTL(6)
S RA("OBRZ")=RA("OBRZ")_RA("OBR",18)_RAHLFS_RA("OBR",19)_$$STR^RAO7UTL(11)_RA("OBR",30)_RAHLFS_RA("OBR",31)
S RATAB=RATAB+1,@(RAVAR_RATAB_")")=RA("OBRZ")
K RA("OBR"),RA("OBRZ")
; nte
SS1 I RAORDCTR="XX",RAD70SB'=0 D ;P18 nte segment
. N RA18Z S RA18Z=$$GETTCOM^RAUTL11(+RA0,$P(RAD70SB,"^",1),$P(RAD70SB,"^",2))
. I RA18Z="" K RA18Z Q
. S RATAB=RATAB+1,@(RAVAR_RATAB_")")="NTE"_RAHLFS_"16"_RAHLFS_"L"_RAHLFS_$E(RA18Z,1,245)
. K RA18Z Q
; obx
;P18 next line was modified - Clinical History capture
;----- P75 modifications -----
I '$$PATCH^XPDUTL("OR*3.0*243") D ;Reason for Study captured & passed as Clinical History
. S RACNT=1,RATAB=RATAB+1 ;set Set ID (RACNT) value at one (denotes Reason for Study)
. S @(RAVAR_RATAB_")")="OBX"_RAHLFS_RACNT_RAHLFS_"TX"_RAHLFS_"2000.02^Clinical History^AS4"_RAHLFS_"1"_RAHLFS_"REASON FOR STUDY: "_RAREASDY
. S RACNT=RACNT+1,RATAB=RATAB+1,$P(RABREAK,"-",($L("REASON FOR STUDY: "_RAREASDY)+1))=""
. S @(RAVAR_RATAB_")")="OBX"_RAHLFS_RACNT_RAHLFS_"TX"_RAHLFS_"2000.02^Clinical History^AS4"_RAHLFS_"1"_RAHLFS_RABREAK
. K RABREAK
. Q
E S RACNT=0 ;OR*3.0*243 is installed, Reason for Study captured in OBR-31.2
;capture only clinical history data. Set ID starts at zero
SS6 S A=0 F S A=$S(RAORDCTR="XX"&(RAD70SB'=0):$O(^RADPT(+RA0,"DT",$P(RAD70SB,"^",1),"P",$P(RAD70SB,"^",2),"H",A)),1:$O(^RAO(75.1,RAOIFN,"H",A))) Q:A'>0 D
SS7 . S RACNT=RACNT+1,RATAB=RATAB+1
. ;P18 next line was modified
. S @(RAVAR_RATAB_")")="OBX"_RAHLFS_RACNT_RAHLFS_"TX"_RAHLFS_"2000.02^Clinical History^AS4"_RAHLFS_"1"_RAHLFS_$S(RAORDCTR="XX"&(RAD70SB'=0):$G(^RADPT(+RA0,"DT",$P(RAD70SB,"^",1),"P",$P(RAD70SB,"^",2),"H",A,0)),1:$G(^RAO(75.1,RAOIFN,"H",A,0)))
. Q
S DFN=RADFN D DEM^VADPT
;
;IHS/BJI/DAY - Patch 1005 - Gender Fix
;I $P(VADM(5),U)]"",("Ff"[$P(VADM(5),U)) D
I $P(VADM(5),U)]"",$P(VADM(5),U)'="M" D
.;
. S RATAB=RATAB+1,RACNT=RACNT+1
. S @(RAVAR_RATAB_")")="OBX"_RAHLFS_RACNT_RAHLFS_"TX"_RAHLFS_"2000.33^Pregnant^AS4"_$$STR^RAO7UTL(2)_$S($P(RA0,U,13)="":"","Yy"[$P(RA0,U,13):"Y","Nn"[$P(RA0,U,13):"N",1:"U")
. Q
I +$P(RA0,U,9) D
. S RATAB=RATAB+1,RACNT=RACNT+1
. S @(RAVAR_RATAB_")")="OBX"_RAHLFS_RACNT_RAHLFS_"CE"_RAHLFS_"34^Contract Sharing/Source^99DD"_$$STR^RAO7UTL(2)_$P(RA0,U,9)_RAECH(1)_$P($G(^DIC(34,+$P(RA0,U,9),0)),U)
. Q
I RAR]"" D
. S RATAB=RATAB+1,RACNT=RACNT+1
. S @(RAVAR_RATAB_")")="OBX"_RAHLFS_RACNT_RAHLFS_"TX"_RAHLFS_"^Research Source^"_$$STR^RAO7UTL(2)_RAR
. Q
I +$P(RA0,U,12) D
. S RATAB=RATAB+1,RACNT=RACNT+1
. S @(RAVAR_RATAB_")")="OBX"_RAHLFS_RACNT_RAHLFS_"TS"_RAHLFS_"^Pre Op Scheduled Date/Time^"_$$STR^RAO7UTL(2)_$$HLDATE^HLFNC($P(RA0,U,12),"TS")
. Q
; DG1 Segment
;*Billing Awareness Project:
; Send Ordering ICD Dx data to CPRS: DG1 and related ZCL segments.
I $D(RABWDX1) D
. N RA1 S RA1=""
. F S RA1=$O(RABWDX1(RA1)) Q:RA1="" D
.. S RATAB=RATAB+1,RACNT=RACNT+1
.. S @(RAVAR_RATAB_")")=RABWDX1(RA1)
. Q
;*
K RAREASDY,VA,VADM,VAERR D MSG^RAO7UTL("RA EVSEND OR",.@RAVARBLE)
Q
RAO7NEW ;HISC/FPT - Create entry in OE/RR Order file (100) ; 06 Oct 2013 11:11 AM
+1 ;;5.0;Radiology/Nuclear Medicine;**5,10,18,41,75,1005**;Mar 16, 1998 ;Build 13
+2 ;
+3 ; This routine invokes IA #1300-A, #2083, #10082
+4 ;last modification for P18 by SS July 5,2000
EN1(RAOIFN) ; 'RAOIFN' is the ien in file 75.1
+1 ; In RA*5.0*18 this call is used when procedure CHANGED during registration, adding to visit and editing
+2 ; New vars & define the following variables: RAECH, RAECH array & RAHLFS
+3 NEW A,B,DFN,RA,RA0,RACNT,RACPT,RADFN,RAECH,RAHL7DT,RAHLFS,RALOC,RANATURE
+4 NEW RAPRIOR,RAPROC,RAR,RARMBED,RATAB,RAVAR,RAWARD,RAXIT
+5 ;P18, OR Order No, "DT" of #70, Orderctrl,subscr of 70
NEW RAORORDN,RAD70SB,RAORDCTR
+6 ; Billing Awareness Project.
NEW RABWDX,RABWDX1
+7 ;P18, these sets mean that it's request mode (not the case, when procedure changed during registering or editing)
SET RAORORDN=""
SET RAD70SB=0
SET RAORDCTR="SN"
+8 ;P18,if register mode (see RAREG2 for EN1^RAO7XX)
IF $DATA(RAREGMOD)
SET RAORORDN=$PIECE(^RAO(75.1,RAOIFN,0),"^",7)_"^OR"
SET RAORDCTR="XX"
+9 SET RATAB=1
DO EN1^RAO7UTL
+10 SET RA0=$GET(^RAO(75.1,RAOIFN,0))
IF RA0']""
QUIT
SS2 ;P18, update RA0 with #70 inf, sets RAD70SB, that provide D2^D3 of #70
IF RAORDCTR="XX"
DO UPDTRA0^RAO7XX
+1 SET RADFN=+RA0
SET RAR=$GET(^RAO(75.1,RAOIFN,"R"))
SS3 ;P18
IF RAORDCTR="XX"
IF RAD70SB'=0
SET RAR=$GET(^RADPT(+RA0,"DT",$PIECE(RAD70SB,"^",1),"P",$PIECE(RAD70SB,"^",2),"R"))
+1 ;
+2 ;*Billing Awarenes Project:
+3 ; Retrieve Ordering ICD Dx data to Send to CPRS.
+4 DO SENDCPRS^RABWORD1(RAOIFN)
+5 ;*
+6 SET RAVAR="RATMP("
SET RAVARBLE="RATMP"
+7 ; msh
+8 ;P18
SET @(RAVAR_RATAB_")")=$$MSH^RAO7UTL("ORM^O01")
+9 ; pid
+10 SET RATAB=RATAB+1
SET @(RAVAR_RATAB_")")=$$PID^RAO7UTL(RA0)
+11 ; pv1
+12 SET RATAB=RATAB+1
SET @(RAVAR_RATAB_")")=$$PV1^RAO7UTL(RA0)
+13 KILL RA("PV1"),VAIP,RABWVSIT
+14 ; orc
+15 SET RAHL7DT=$$HLDATE^HLFNC($PIECE(RA0,U,21),"TS")
SET RAPRIOR=$PIECE(RA0,U,6)
+16 SET RAPRIOR=$SELECT(RAPRIOR=1:"S",RAPRIOR=2:"A",RAPRIOR=9:"R",1:"")
+17 SET RA("ORC",7)="^^^"_RAHL7DT_"^^"_RAPRIOR
+18 SET RA("ORC",10)=$PIECE(RA0,U,15)
SET RA("ORC",12)=$PIECE(RA0,U,14)
+19 ;approving radiologist
SET RA("ORC",11)=$PIECE(RA0,U,8)
+20 SET RA("ORC",15)=$$HLDATE^HLFNC($PIECE(RA0,"^",16),"TS")
+21 SET RANATURE=""
IF $LENGTH($PIECE(RA0,"^",26))
SET RANATURE=$$UP^XLFSTR($PIECE(RA0,"^",26))_RAECH(1)_$$EXTERNAL^DILFD(75.1,26,"",$PIECE(RA0,"^",26))
+22 FOR I=1,2
IF '$LENGTH($PIECE(RANATURE,"^",I))
SET RANATURE="S"_RAECH(1)_"SERVICE CORRECTION"
+23 KILL I
SET RA("ORC",16)=RANATURE_RAECH(1)_"99ORN"_RAECH(1)_RAECH(1)_RAECH(1)
+24 SET RATAB=RATAB+1
+25 ;P18, next line was modified
SS4 SET @(RAVAR_RATAB_")")="ORC"_RAHLFS_RAORDCTR_RAHLFS_RAORORDN_RAHLFS_RAOIFN_RAECH(1)_"RA"_$$STR^RAO7UTL(4)_RA("ORC",7)_$$STR^RAO7UTL(3)_RA("ORC",10)_RAHLFS_RA("ORC",11)_RAHLFS_RA("ORC",12)_$$STR^RAO7UTL(3)_RA("ORC",15)_RAHLFS_RA("ORC",16)
+1 KILL RA("ORC")
+2 ; obr
+3 SET RAPROC(0)=$GET(^RAMIS(71,+$PIECE(RA0,U,2),0))
SET RAPROC(9)=+$PIECE(RAPROC(0),U,9)
+4 SET RACPT(0)=$$NAMCODE^RACPTMSC(RAPROC(9),DT)
+5 SET RA("OBR",4)=$PIECE(RACPT(0),U)_U_$PIECE(RACPT(0),U,2)_U_"CPT4"_U_+$PIECE(RA0,U,2)_U_$PIECE(RAPROC(0),U)_"^99RAP"
+6 SET RA("OBR",12)=""
+7 IF $PIECE(RA0,U,24)]""&("Yy"[$PIECE(RA0,U,24))
SET RA("OBR",12)="isolation"
+8 SET RA("OBR",18)=""
SS5 ;P18 by SS
IF RAORDCTR="XX"
IF RAD70SB'=0
DO MODIF70^RAO7XX($PIECE(RAD70SB,"^",1),$PIECE(RAD70SB,"^",2))
GOTO CONTIN
+1 IF $ORDER(^RAO(75.1,RAOIFN,"M",0))
Begin DoDot:1
+2 SET (A,RAXIT)=0
+3 FOR
SET A=$ORDER(^RAO(75.1,RAOIFN,"M",A))
IF A'>0
QUIT
Begin DoDot:2
+4 SET B(0)=$GET(^RAO(75.1,RAOIFN,"M",A,0))
+5 SET B(1)=$PIECE($GET(^RAMIS(71.2,+B(0),0)),U)
+6 IF $LENGTH(RA("OBR",18))+$LENGTH(B(1))>60
SET RAXIT=1
QUIT
+7 SET RA("OBR",18)=$GET(RA("OBR",18))_B(1)_RAECH(2)
+8 QUIT
End DoDot:2
IF RAXIT
QUIT
+9 SET RA("OBR",18)=$PIECE(RA("OBR",18),RAECH(2),1,$LENGTH(RA("OBR",18),RAECH(2))-1)
+10 QUIT
End DoDot:1
CONTIN SET RALOC(0)=$GET(^RA(79.1,+$PIECE(RA0,U,20),0))
+1 SET RA("OBR",19)=+$PIECE(RA0,U,20)_U_$PIECE($GET(^SC(+RALOC(0),0)),U)
+2 IF +RA("OBR",19)'>0
SET RA("OBR",19)=""
+3 SET RA("OBR",30)=$SELECT($PIECE(RA0,U,19)="":"","Aa"[$PIECE(RA0,U,19):"WALK","Pp"[$PIECE(RA0,U,19):"PORT","Ss"[$PIECE(RA0,U,19):"CART","Ww"[$PIECE(RA0,U,19):"WHLC",1:"")
+4 ;----- P75 REASON FOR STUDY OBR-31.2 -----
+5 SET (RAREASDY,RA("OBR",31))=RAECH(1)_$PIECE($GET(^RAO(75.1,RAOIFN,.1)),U)
+6 SET RA("OBRZ")="OBR"_$$STR^RAO7UTL(4)_RA("OBR",4)_$$STR^RAO7UTL(8)_RA("OBR",12)_$$STR^RAO7UTL(6)
+7 SET RA("OBRZ")=RA("OBRZ")_RA("OBR",18)_RAHLFS_RA("OBR",19)_$$STR^RAO7UTL(11)_RA("OBR",30)_RAHLFS_RA("OBR",31)
+8 SET RATAB=RATAB+1
SET @(RAVAR_RATAB_")")=RA("OBRZ")
+9 KILL RA("OBR"),RA("OBRZ")
+10 ; nte
SS1 ;P18 nte segment
IF RAORDCTR="XX"
IF RAD70SB'=0
Begin DoDot:1
+1 NEW RA18Z
SET RA18Z=$$GETTCOM^RAUTL11(+RA0,$PIECE(RAD70SB,"^",1),$PIECE(RAD70SB,"^",2))
+2 IF RA18Z=""
KILL RA18Z
QUIT
+3 SET RATAB=RATAB+1
SET @(RAVAR_RATAB_")")="NTE"_RAHLFS_"16"_RAHLFS_"L"_RAHLFS_$EXTRACT(RA18Z,1,245)
+4 KILL RA18Z
QUIT
End DoDot:1
+5 ; obx
+6 ;P18 next line was modified - Clinical History capture
+7 ;----- P75 modifications -----
+8 ;Reason for Study captured & passed as Clinical History
IF '$$PATCH^XPDUTL("OR*3.0*243")
Begin DoDot:1
+9 ;set Set ID (RACNT) value at one (denotes Reason for Study)
SET RACNT=1
SET RATAB=RATAB+1
+10 SET @(RAVAR_RATAB_")")="OBX"_RAHLFS_RACNT_RAHLFS_"TX"_RAHLFS_"2000.02^Clinical History^AS4"_RAHLFS_"1"_RAHLFS_"REASON FOR STUDY: "_RAREASDY
+11 SET RACNT=RACNT+1
SET RATAB=RATAB+1
SET $PIECE(RABREAK,"-",($LENGTH("REASON FOR STUDY: "_RAREASDY)+1))=""
+12 SET @(RAVAR_RATAB_")")="OBX"_RAHLFS_RACNT_RAHLFS_"TX"_RAHLFS_"2000.02^Clinical History^AS4"_RAHLFS_"1"_RAHLFS_RABREAK
+13 KILL RABREAK
+14 QUIT
End DoDot:1
+15 ;OR*3.0*243 is installed, Reason for Study captured in OBR-31.2
IF '$TEST
SET RACNT=0
+16 ;capture only clinical history data. Set ID starts at zero
SS6 SET A=0
FOR
SET A=$SELECT(RAORDCTR="XX"&(RAD70SB'=0):$ORDER(^RADPT(+RA0,"DT",$PIECE(RAD70SB,"^",1),"P",$PIECE(RAD70SB,"^",2),"H",A)),1:$ORDER(^RAO(75.1,RAOIFN,"H",A)))
IF A'>0
QUIT
Begin DoDot:1
SS7 SET RACNT=RACNT+1
SET RATAB=RATAB+1
+1 ;P18 next line was modified
+2 SET @(RAVAR_RATAB_")")="OBX"_RAHLFS_RACNT_RAHLFS_"TX"_RAHLFS_"2000.02^Clinical History^AS4"_RAHLFS_"1"_RAHLFS_$SELECT(RAORDCTR="XX"&(RAD70SB'=0):$GET(^RADPT(+RA0,"DT",$PIECE(RAD70SB,"^",1),"P",...
... $PIECE(RAD70SB,"^",2),"H",A,0)),1:$GET(^RAO(75.1,RAOIFN,"H",A,0)))
+3 QUIT
End DoDot:1
+4 SET DFN=RADFN
DO DEM^VADPT
+5 ;
+6 ;IHS/BJI/DAY - Patch 1005 - Gender Fix
+7 ;I $P(VADM(5),U)]"",("Ff"[$P(VADM(5),U)) D
+8 IF $PIECE(VADM(5),U)]""
IF $PIECE(VADM(5),U)'="M"
Begin DoDot:1
+9 ;
+10 SET RATAB=RATAB+1
SET RACNT=RACNT+1
+11 SET @(RAVAR_RATAB_")")="OBX"_RAHLFS_RACNT_RAHLFS_"TX"_RAHLFS_"2000.33^Pregnant^AS4"_$$STR^RAO7UTL(2)_$SELECT($PIECE(RA0,U,13)="":"","Yy"[$PIECE(RA0,U,13):"Y","Nn"[$PIECE(RA0,U,13):"N",1:"U")
+12 QUIT
End DoDot:1
+13 IF +$PIECE(RA0,U,9)
Begin DoDot:1
+14 SET RATAB=RATAB+1
SET RACNT=RACNT+1
+15 SET @(RAVAR_RATAB_")")="OBX"_RAHLFS_RACNT_RAHLFS_"CE"_RAHLFS_"34^Contract Sharing/Source^99DD"_$$STR^RAO7UTL(2)_$PIECE(RA0,U,9)_RAECH(1)_$PIECE($GET(^DIC(34,+$PIECE(RA0,U,9),0)),U)
+16 QUIT
End DoDot:1
+17 IF RAR]""
Begin DoDot:1
+18 SET RATAB=RATAB+1
SET RACNT=RACNT+1
+19 SET @(RAVAR_RATAB_")")="OBX"_RAHLFS_RACNT_RAHLFS_"TX"_RAHLFS_"^Research Source^"_$$STR^RAO7UTL(2)_RAR
+20 QUIT
End DoDot:1
+21 IF +$PIECE(RA0,U,12)
Begin DoDot:1
+22 SET RATAB=RATAB+1
SET RACNT=RACNT+1
+23 SET @(RAVAR_RATAB_")")="OBX"_RAHLFS_RACNT_RAHLFS_"TS"_RAHLFS_"^Pre Op Scheduled Date/Time^"_$$STR^RAO7UTL(2)_$$HLDATE^HLFNC($PIECE(RA0,U,12),"TS")
+24 QUIT
End DoDot:1
+25 ; DG1 Segment
+26 ;*Billing Awareness Project:
+27 ; Send Ordering ICD Dx data to CPRS: DG1 and related ZCL segments.
+28 IF $DATA(RABWDX1)
Begin DoDot:1
+29 NEW RA1
SET RA1=""
+30 FOR
SET RA1=$ORDER(RABWDX1(RA1))
IF RA1=""
QUIT
Begin DoDot:2
+31 SET RATAB=RATAB+1
SET RACNT=RACNT+1
+32 SET @(RAVAR_RATAB_")")=RABWDX1(RA1)
End DoDot:2
+33 QUIT
End DoDot:1
+34 ;*
+35 KILL RAREASDY,VA,VADM,VAERR
DO MSG^RAO7UTL("RA EVSEND OR",.@RAVARBLE)
+36 QUIT
