RAO7PC3 ;HISC/SWM&CRT-Procedure Call utilities. ;8/15/08 16:45
;;5.0;Radiology/Nuclear Medicine;**16,26,27,56,95**;Mar 16, 1998;Build 7
;Supported IA #2056 GET1^DIQ
;Supported IA 10104 UP^XLFSTR
;; api to return entire report (same as auto e-mail's)
EN3(X) ; Return narrative text for exam(s)
; Input:
; X-> Exam id in one of two forms:
; 1) Pat. DFN^inv. exam date^Case IEN
; Retrieves a single report for a single exam
; 2) Pat. DFN^inv. exam date^
; Retrieves all reports for a set of exams ordered on one order
;
; Note: Input delimiter can be any of the following: ^~\&;-
; a delimiter may be a single space i.e, " "
;
; Output:
; ^TMP($J,"RAE3",Patient IEN,case IEN,procedure name)=report status^
; abnormal alert^CPRS Order ien
; ^TMP($J,"RAE3",Patient IEN,case IEN,procedure name,n)=line n of rpt
; ^TMP($J,"RAE3",Patient IEN,"PRINT_SET")=null (IF this is a printset)
; ^TMP($J,"RAE3",Patient IEN,"ORD")=name of ordered procedure for
; examsets and printsets
; ^TMP($J,"RAE3",Patient IEN,"ORD",case IEN)=name of ordered procedure
; for that case; not part of an examset or printset
;
;
K ^TMP($J,"RAE3"),^TMP($J,"RA AUTOE")
K RAU S RAU=$$DEL^RAO7PC1(X) I RAU="" K RAU Q
Q:'$P(X,RAU)!('$P(X,RAU,2)) ; Quit if no Pat. DFN -or- no inv. exam DT
N RACIEN,RADFN,RAINVXDT,RAPSET,RAUTOE,Y S RAPSET=0
S RADFN=$P(X,RAU),RAINVXDT=$P(X,RAU,2),RACIEN=+$P(X,RAU,3)
K RAU Q:'($D(^RADPT(RADFN,"DT",RAINVXDT,0))#2)
I RACIEN D CASE(RACIEN) Q
S Y=0
F S Y=$O(^RADPT(RADFN,"DT",RAINVXDT,"P",Y)) Q:Y'>0 D
. D CASE(Y) S RAPSET=0
. Q
Q
EN30(RAOIFN) ; Return narrative text for exam(s).
; To be used with the EN3 entry point above.
;
; Input: RAOIFN -> the ien of Rad/Nuc Med Order
;
Q:'RAOIFN ; order passed in as 0 or null
Q:'$D(^RAO(75.1,RAOIFN,0)) ; no such order
Q:'$D(^RADPT("AO",RAOIFN)) ; no exam associated with this order
N RADFN,RADTI,RACNI,RAXSET
S RADFN=+$O(^RADPT("AO",RAOIFN,0)) Q:'RADFN
S RADTI=+$O(^RADPT("AO",RAOIFN,RADFN,0)) Q:'RADTI
S RAXSET=+$P($G(^RADPT(RADFN,"DT",RADTI,0)),"^",5) ; set if RAXSET=1
I RAXSET D EN3(RADFN_"^"_RADTI_"^") Q ; exam set, hit EN3 code
; the following code is executed for non-exam set examinations
S RACNI=+$O(^RADPT("AO",RAOIFN,RADFN,RADTI,0)) Q:'RACNI
D EN3(RADFN_"^"_RADTI_"^"_RACNI)
Q
CASE(Y) ;
N N,RABNOR,RACASE,RACIEN,RADIAG,RAEXAM,RAINCLUD,RAOPRC,RAORD,BLANK
N RAMSG,RAPDIAG,RAPROC,RARDE,RARPT,RARPTST,RASPACE,SKIP,X,ZZRADFN,X0,X1,X2,RASIGVES,RARPTST2
;
S RACIEN=Y,$P(BLANK," ",80)=""
S RAEXAM(0)=$G(^RADPT(RADFN,"DT",RAINVXDT,"P",RACIEN,0)) Q:RAEXAM(0)']""
S RACASE=$P(RAEXAM(0),"^")
S:$P(RAEXAM(0),"^",25)=2 RAPSET=1
S:RAPSET=1 ^TMP($J,"RAE3",RADFN,"PRINT_SET")=""
S RAPROC(0)=$G(^RAMIS(71,+$P(RAEXAM(0),"^",2),0))
S RAPROC=$S($P(RAPROC(0),"^")]"":$P(RAPROC(0),"^"),1:"Unknown")
S RAORD(0)=$G(^RAO(75.1,+$P(RAEXAM(0),"^",11),0))
S RAORD(7)=$P(RAORD(0),"^",7)
S RAOPRC(0)=$G(^RAMIS(71,+$P(RAORD(0),"^",2),0))
S RAOPRC=$S($P(RAOPRC(0),"^")]"":$P(RAOPRC(0),"^"),1:"Unknown")
S RAPDIAG(0)=$G(^RA(78.3,+$P(RAEXAM(0),"^",13),0))
S RARPT=+$P(RAEXAM(0),"^",17),RARPTST2=$$UL^RAO7PC1A($$RSTAT^RAO7PC1A())
S RARPT(0)=$G(^RARPT(RARPT,0)),RARPTST=$P(RARPT(0),"^",5)
S RASIGVES="" I RARPTST="V",$P(RARPT(0),U,10)]"",$P(RARPT(0),U,9)]"" S X2=RARPT,X1=$P(RARPT(0),U,9),X=$P(RARPT(0),U,10) D DE^XUSHSHP S:X]"" RASIGVES="/ES/"_X
S RARDE=$$GET1^DIQ(74,RARPT_",",8,"E")
; View whole report if Rad User or status is R or V.
D CHKUSR^RAUTL2 S RAINCLUD=RAMSG
;allow V, R, EF rpts to be seen by non-Radiology CPRS users - patch 95
S RAINCLUD=$S(RAMSG:1,"^V^R^EF^"[("^"_RARPTST_"^"):1,1:0)
S RABNOR=$$UP^XLFSTR($P(RAPDIAG(0),"^",4)) S:RABNOR'="Y" RABNOR=""
;
I $P(RAEXAM(0),"^",25) S ^TMP($J,"RAE3",RADFN,"ORD")=RAOPRC
I '$P(RAEXAM(0),"^",25) S ^TMP($J,"RAE3",RADFN,"ORD",RACIEN)=RAOPRC
;
I RAPSET'<0 D
.S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC)="^"_RABNOR_"^"_RAORD(7)
.S $P(^TMP($J,"RAE3",RADFN,RACIEN,RAPROC),"^")=RARPTST2
S:RAPSET<0 ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC)=""
S:RAPSET=1 RAPSET=-1
;
; Setup variables then call ^RARTR to create Rad Report on ^TMP nodes
; 2 stages: INIT^RARTR creates header info, PRT1^RARTR for the report
; (save RADFN as RARTR kills it at the end)
;
S RAUTOE=1,ZZRADFN=RADFN,RAACNT=0
S X="^"_RADFN_"^"_(9999999.9999-RAINVXDT)_"^"_RACASE_"^"_RARPTST
;
D INIT^RARTR
S (RAFFLF,RAORIOF)=$G(IOF)
I RAY0<0!(RAY1<0)!(RAY2<0)!(RAY3<0) K RAFFLF Q
;
S RAVERF=0
I RARPTST2="No Report" D
.S:'$D(RAMDIV) RAMDIV=+$P(^RADPT(RADFN,"DT",RAINVXDT,0),"^",3)
.S:'$D(RAMDV) RAMDV=$S($D(^RA(79,RAMDIV,.1)):^(.1),1:""),RAMDV=$TR(RAMDV,"YNyn","1010")
D PRT1^RARTR
S RADFN=ZZRADFN
Q:'$D(^TMP($J,"RA AUTOE"))
;
; Now manipulate ^TMP($J,"RA AUTOE" and save as ^TMP($J,"RAE3"
; Step 1: Change Case Number to Exam Date
; Step 2: Remove Impression, Report & Diagnostic Codes if not
; Released or Verified or Electronically Filed
; Also remove "Att Phys" and "Pri Phys"
; Step 3: Change Status to Report Status & add Reported Date
; Step 4: If No Report then get Clin History from file #70.
; ** WITH PATCH 27 - NO LONGER NEED TO DO STEP 4 **
;
STEP1 S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,1)=$P(^TMP($J,"RA AUTOE",1),"Case: ")
S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,1.5)="Exm Date: "_$$GET1^DIQ(70.02,RAINVXDT_","_RADFN_",",.01,"E")
;
STEP2 K SKIP S N=1 F S N=$O(^TMP($J,"RA AUTOE",N)) Q:N="" D
. S X0=^TMP($J,"RA AUTOE",N),X1=$E(X0,1,10)
. I (X1="Att Phys: ")!(X1="Pri Phys: ") D
.. S ^TMP($J,"RA AUTOE",N)=$E(BLANK,1,41)_$E(X0,42,$L(X0))
.. Q
.;I RARPTST2="No Report",($E(^TMP($J,"RA AUTOE",N),1,21)=" Clinical History:") D STEP4
.I $E(^TMP($J,"RA AUTOE",N),1,12)=" Report: " D STEP3 Q:RARPTST2="No Report"
.I 'RAINCLUD,$E(^TMP($J,"RA AUTOE",N),1,15)=" Impression:" D
..S SKIP=1,^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,N+0.1)=""
.I 'RAINCLUD,$E(^TMP($J,"RA AUTOE",N),1,28)=" Primary Diagnostic Code:" D
..S SKIP=1 S ^TMP($J,"RA AUTOE",N)=$E(^TMP($J,"RA AUTOE",N),1,28)
.I 'RAINCLUD,$E(^TMP($J,"RA AUTOE",N),1,31)=" Secondary Diagnostic Codes:" D
..S SKIP=1,^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,N+0.1)=""
.I $E(^TMP($J,"RA AUTOE",N),1,27)="Primary Interpreting Staff:" K SKIP
.I $D(SKIP) S SKIP=SKIP+1
.I $G(SKIP)<3 S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,N)=^TMP($J,"RA AUTOE",N)
.Q
;
XIT K ^TMP($J,"RA AUTOE")
Q
;
STEP3 S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,N-0.4)=" Report Status: "_RARPTST2
I RARPTST2="No Report" S N="^" Q
S $P(RASPACE," ",46)=""
S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,N-0.4)=^(N-0.4)_$E(RASPACE,1,46-$L(^(N-0.4)))_"Date Reported: "_RARDE
I RARPTST="V" D
. S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,N-0.3)=RASPACE_" Date Verified: "_$P($$GET1^DIQ(74,+$P(RAEXAM(0),"^",17),7),"@")
. S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,N-0.2)=" Verifier E-Sig:"_RASIGVES
. Q
S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,N-0.1)=""
S ^TMP($J,"RA AUTOE",N)=" Report:"
I 'RAINCLUD S SKIP=1,^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,N+0.1)=""
Q
;
STEP4 I +$O(^RADPT(RADFN,"DT",RAINVXDT,"P",RACIEN,"H",0)) D
.N RAI,RAIN,Z S (RAI,Z)=0,RAIN=N_".000"
.F S Z=$O(^RADPT(RADFN,"DT",RAINVXDT,"P",RACIEN,"H",Z)) Q:Z'>0 D
..S RAI=RAI+1
..S RAIN=$E(RAIN,1,$L(RAIN)-$L(RAI))_RAI
..S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,RAIN)=" "_$G(^RADPT(RADFN,"DT",RAINVXDT,"P",RACIEN,"H",Z,0))
Q
RAO7PC3 ;HISC/SWM&CRT-Procedure Call utilities. ;8/15/08 16:45
+1 ;;5.0;Radiology/Nuclear Medicine;**16,26,27,56,95**;Mar 16, 1998;Build 7
+2 ;Supported IA #2056 GET1^DIQ
+3 ;Supported IA 10104 UP^XLFSTR
+4 ;; api to return entire report (same as auto e-mail's)
EN3(X) ; Return narrative text for exam(s)
+1 ; Input:
+2 ; X-> Exam id in one of two forms:
+3 ; 1) Pat. DFN^inv. exam date^Case IEN
+4 ; Retrieves a single report for a single exam
+5 ; 2) Pat. DFN^inv. exam date^
+6 ; Retrieves all reports for a set of exams ordered on one order
+7 ;
+8 ; Note: Input delimiter can be any of the following: ^~\&;-
+9 ; a delimiter may be a single space i.e, " "
+10 ;
+11 ; Output:
+12 ; ^TMP($J,"RAE3",Patient IEN,case IEN,procedure name)=report status^
+13 ; abnormal alert^CPRS Order ien
+14 ; ^TMP($J,"RAE3",Patient IEN,case IEN,procedure name,n)=line n of rpt
+15 ; ^TMP($J,"RAE3",Patient IEN,"PRINT_SET")=null (IF this is a printset)
+16 ; ^TMP($J,"RAE3",Patient IEN,"ORD")=name of ordered procedure for
+17 ; examsets and printsets
+18 ; ^TMP($J,"RAE3",Patient IEN,"ORD",case IEN)=name of ordered procedure
+19 ; for that case; not part of an examset or printset
+20 ;
+21 ;
+22 KILL ^TMP($JOB,"RAE3"),^TMP($JOB,"RA AUTOE")
+23 KILL RAU
SET RAU=$$DEL^RAO7PC1(X)
IF RAU=""
KILL RAU
QUIT
+24 ; Quit if no Pat. DFN -or- no inv. exam DT
IF '$PIECE(X,RAU)!('$PIECE(X,RAU,2))
QUIT
+25 NEW RACIEN,RADFN,RAINVXDT,RAPSET,RAUTOE,Y
SET RAPSET=0
+26 SET RADFN=$PIECE(X,RAU)
SET RAINVXDT=$PIECE(X,RAU,2)
SET RACIEN=+$PIECE(X,RAU,3)
+27 KILL RAU
IF '($DATA(^RADPT(RADFN,"DT",RAINVXDT,0))#2)
QUIT
+28 IF RACIEN
DO CASE(RACIEN)
QUIT
+29 SET Y=0
+30 FOR
SET Y=$ORDER(^RADPT(RADFN,"DT",RAINVXDT,"P",Y))
IF Y'>0
QUIT
Begin DoDot:1
+31 DO CASE(Y)
SET RAPSET=0
+32 QUIT
End DoDot:1
+33 QUIT
EN30(RAOIFN) ; Return narrative text for exam(s).
+1 ; To be used with the EN3 entry point above.
+2 ;
+3 ; Input: RAOIFN -> the ien of Rad/Nuc Med Order
+4 ;
+5 ; order passed in as 0 or null
IF 'RAOIFN
QUIT
+6 ; no such order
IF '$DATA(^RAO(75.1,RAOIFN,0))
QUIT
+7 ; no exam associated with this order
IF '$DATA(^RADPT("AO",RAOIFN))
QUIT
+8 NEW RADFN,RADTI,RACNI,RAXSET
+9 SET RADFN=+$ORDER(^RADPT("AO",RAOIFN,0))
IF 'RADFN
QUIT
+10 SET RADTI=+$ORDER(^RADPT("AO",RAOIFN,RADFN,0))
IF 'RADTI
QUIT
+11 ; set if RAXSET=1
SET RAXSET=+$PIECE($GET(^RADPT(RADFN,"DT",RADTI,0)),"^",5)
+12 ; exam set, hit EN3 code
IF RAXSET
DO EN3(RADFN_"^"_RADTI_"^")
QUIT
+13 ; the following code is executed for non-exam set examinations
+14 SET RACNI=+$ORDER(^RADPT("AO",RAOIFN,RADFN,RADTI,0))
IF 'RACNI
QUIT
+15 DO EN3(RADFN_"^"_RADTI_"^"_RACNI)
+16 QUIT
CASE(Y) ;
+1 NEW N,RABNOR,RACASE,RACIEN,RADIAG,RAEXAM,RAINCLUD,RAOPRC,RAORD,BLANK
+2 NEW RAMSG,RAPDIAG,RAPROC,RARDE,RARPT,RARPTST,RASPACE,SKIP,X,ZZRADFN,X0,X1,X2,RASIGVES,RARPTST2
+3 ;
+4 SET RACIEN=Y
SET $PIECE(BLANK," ",80)=""
+5 SET RAEXAM(0)=$GET(^RADPT(RADFN,"DT",RAINVXDT,"P",RACIEN,0))
IF RAEXAM(0)']""
QUIT
+6 SET RACASE=$PIECE(RAEXAM(0),"^")
+7 IF $PIECE(RAEXAM(0),"^",25)=2
SET RAPSET=1
+8 IF RAPSET=1
SET ^TMP($JOB,"RAE3",RADFN,"PRINT_SET")=""
+9 SET RAPROC(0)=$GET(^RAMIS(71,+$PIECE(RAEXAM(0),"^",2),0))
+10 SET RAPROC=$SELECT($PIECE(RAPROC(0),"^")]"":$PIECE(RAPROC(0),"^"),1:"Unknown")
+11 SET RAORD(0)=$GET(^RAO(75.1,+$PIECE(RAEXAM(0),"^",11),0))
+12 SET RAORD(7)=$PIECE(RAORD(0),"^",7)
+13 SET RAOPRC(0)=$GET(^RAMIS(71,+$PIECE(RAORD(0),"^",2),0))
+14 SET RAOPRC=$SELECT($PIECE(RAOPRC(0),"^")]"":$PIECE(RAOPRC(0),"^"),1:"Unknown")
+15 SET RAPDIAG(0)=$GET(^RA(78.3,+$PIECE(RAEXAM(0),"^",13),0))
+16 SET RARPT=+$PIECE(RAEXAM(0),"^",17)
SET RARPTST2=$$UL^RAO7PC1A($$RSTAT^RAO7PC1A())
+17 SET RARPT(0)=$GET(^RARPT(RARPT,0))
SET RARPTST=$PIECE(RARPT(0),"^",5)
+18 SET RASIGVES=""
IF RARPTST="V"
IF $PIECE(RARPT(0),U,10)]""
IF $PIECE(RARPT(0),U,9)]""
SET X2=RARPT
SET X1=$PIECE(RARPT(0),U,9)
SET X=$PIECE(RARPT(0),U,10)
DO DE^XUSHSHP
IF X]""
SET RASIGVES="/ES/"_X
+19 SET RARDE=$$GET1^DIQ(74,RARPT_",",8,"E")
+20 ; View whole report if Rad User or status is R or V.
+21 DO CHKUSR^RAUTL2
SET RAINCLUD=RAMSG
+22 ;allow V, R, EF rpts to be seen by non-Radiology CPRS users - patch 95
+23 SET RAINCLUD=$SELECT(RAMSG:1,"^V^R^EF^"[("^"_RARPTST_"^"):1,1:0)
+24 SET RABNOR=$$UP^XLFSTR($PIECE(RAPDIAG(0),"^",4))
IF RABNOR'="Y"
SET RABNOR=""
+25 ;
+26 IF $PIECE(RAEXAM(0),"^",25)
SET ^TMP($JOB,"RAE3",RADFN,"ORD")=RAOPRC
+27 IF '$PIECE(RAEXAM(0),"^",25)
SET ^TMP($JOB,"RAE3",RADFN,"ORD",RACIEN)=RAOPRC
+28 ;
+29 IF RAPSET'<0
Begin DoDot:1
+30 SET ^TMP($JOB,"RAE3",RADFN,RACIEN,RAPROC)="^"_RABNOR_"^"_RAORD(7)
+31 SET $PIECE(^TMP($JOB,"RAE3",RADFN,RACIEN,RAPROC),"^")=RARPTST2
End DoDot:1
+32 IF RAPSET<0
SET ^TMP($JOB,"RAE3",RADFN,RACIEN,RAPROC)=""
+33 IF RAPSET=1
SET RAPSET=-1
+34 ;
+35 ; Setup variables then call ^RARTR to create Rad Report on ^TMP nodes
+36 ; 2 stages: INIT^RARTR creates header info, PRT1^RARTR for the report
+37 ; (save RADFN as RARTR kills it at the end)
+38 ;
+39 SET RAUTOE=1
SET ZZRADFN=RADFN
SET RAACNT=0
+40 SET X="^"_RADFN_"^"_(9999999.9999-RAINVXDT)_"^"_RACASE_"^"_RARPTST
+41 ;
+42 DO INIT^RARTR
+43 SET (RAFFLF,RAORIOF)=$GET(IOF)
+44 IF RAY0<0!(RAY1<0)!(RAY2<0)!(RAY3<0)
KILL RAFFLF
QUIT
+45 ;
+46 SET RAVERF=0
+47 IF RARPTST2="No Report"
Begin DoDot:1
+48 IF '$DATA(RAMDIV)
SET RAMDIV=+$PIECE(^RADPT(RADFN,"DT",RAINVXDT,0),"^",3)
+49 IF '$DATA(RAMDV)
SET RAMDV=$SELECT($DATA(^RA(79,RAMDIV,.1)):^(.1),1:"")
SET RAMDV=$TRANSLATE(RAMDV,"YNyn","1010")
End DoDot:1
+50 DO PRT1^RARTR
+51 SET RADFN=ZZRADFN
+52 IF '$DATA(^TMP($JOB,"RA AUTOE"))
QUIT
+53 ;
+54 ; Now manipulate ^TMP($J,"RA AUTOE" and save as ^TMP($J,"RAE3"
+55 ; Step 1: Change Case Number to Exam Date
+56 ; Step 2: Remove Impression, Report & Diagnostic Codes if not
+57 ; Released or Verified or Electronically Filed
+58 ; Also remove "Att Phys" and "Pri Phys"
+59 ; Step 3: Change Status to Report Status & add Reported Date
+60 ; Step 4: If No Report then get Clin History from file #70.
+61 ; ** WITH PATCH 27 - NO LONGER NEED TO DO STEP 4 **
+62 ;
STEP1 SET ^TMP($JOB,"RAE3",RADFN,RACIEN,RAPROC,1)=$PIECE(^TMP($JOB,"RA AUTOE",1),"Case: ")
+1 SET ^TMP($JOB,"RAE3",RADFN,RACIEN,RAPROC,1.5)="Exm Date: "_$$GET1^DIQ(70.02,RAINVXDT_","_RADFN_",",.01,"E")
+2 ;
STEP2 KILL SKIP
SET N=1
FOR
SET N=$ORDER(^TMP($JOB,"RA AUTOE",N))
IF N=""
QUIT
Begin DoDot:1
+1 SET X0=^TMP($JOB,"RA AUTOE",N)
SET X1=$EXTRACT(X0,1,10)
+2 IF (X1="Att Phys: ")!(X1="Pri Phys: ")
Begin DoDot:2
+3 SET ^TMP($JOB,"RA AUTOE",N)=$EXTRACT(BLANK,1,41)_$EXTRACT(X0,42,$LENGTH(X0))
+4 QUIT
End DoDot:2
+5 ;I RARPTST2="No Report",($E(^TMP($J,"RA AUTOE",N),1,21)=" Clinical History:") D STEP4
+6 IF $EXTRACT(^TMP($JOB,"RA AUTOE",N),1,12)=" Report: "
DO STEP3
IF RARPTST2="No Report"
QUIT
+7 IF 'RAINCLUD
IF $EXTRACT(^TMP($JOB,"RA AUTOE",N),1,15)=" Impression:"
Begin DoDot:2
+8 SET SKIP=1
SET ^TMP($JOB,"RAE3",RADFN,RACIEN,RAPROC,N+0.1)=""
End DoDot:2
+9 IF 'RAINCLUD
IF $EXTRACT(^TMP($JOB,"RA AUTOE",N),1,28)=" Primary Diagnostic Code:"
Begin DoDot:2
+10 SET SKIP=1
SET ^TMP($JOB,"RA AUTOE",N)=$EXTRACT(^TMP($JOB,"RA AUTOE",N),1,28)
End DoDot:2
+11 IF 'RAINCLUD
IF $EXTRACT(^TMP($JOB,"RA AUTOE",N),1,31)=" Secondary Diagnostic Codes:"
Begin DoDot:2
+12 SET SKIP=1
SET ^TMP($JOB,"RAE3",RADFN,RACIEN,RAPROC,N+0.1)=""
End DoDot:2
+13 IF $EXTRACT(^TMP($JOB,"RA AUTOE",N),1,27)="Primary Interpreting Staff:"
KILL SKIP
+14 IF $DATA(SKIP)
SET SKIP=SKIP+1
+15 IF $GET(SKIP)<3
SET ^TMP($JOB,"RAE3",RADFN,RACIEN,RAPROC,N)=^TMP($JOB,"RA AUTOE",N)
+16 QUIT
End DoDot:1
+17 ;
XIT KILL ^TMP($JOB,"RA AUTOE")
+1 QUIT
+2 ;
STEP3 SET ^TMP($JOB,"RAE3",RADFN,RACIEN,RAPROC,N-0.4)=" Report Status: "_RARPTST2
+1 IF RARPTST2="No Report"
SET N="^"
QUIT
+2 SET $PIECE(RASPACE," ",46)=""
+3 SET ^TMP($JOB,"RAE3",RADFN,RACIEN,RAPROC,N-0.4)=^(N-0.4)_$EXTRACT(RASPACE,1,46-$LENGTH(^(N-0.4)))_"Date Reported: "_RARDE
+4 IF RARPTST="V"
Begin DoDot:1
+5 SET ^TMP($JOB,"RAE3",RADFN,RACIEN,RAPROC,N-0.3)=RASPACE_" Date Verified: "_$PIECE($$GET1^DIQ(74,+$PIECE(RAEXAM(0),"^",17),7),"@")
+6 SET ^TMP($JOB,"RAE3",RADFN,RACIEN,RAPROC,N-0.2)=" Verifier E-Sig:"_RASIGVES
+7 QUIT
End DoDot:1
+8 SET ^TMP($JOB,"RAE3",RADFN,RACIEN,RAPROC,N-0.1)=""
+9 SET ^TMP($JOB,"RA AUTOE",N)=" Report:"
+10 IF 'RAINCLUD
SET SKIP=1
SET ^TMP($JOB,"RAE3",RADFN,RACIEN,RAPROC,N+0.1)=""
+11 QUIT
+12 ;
STEP4 IF +$ORDER(^RADPT(RADFN,"DT",RAINVXDT,"P",RACIEN,"H",0))
Begin DoDot:1
+1 NEW RAI,RAIN,Z
SET (RAI,Z)=0
SET RAIN=N_".000"
+2 FOR
SET Z=$ORDER(^RADPT(RADFN,"DT",RAINVXDT,"P",RACIEN,"H",Z))
IF Z'>0
QUIT
Begin DoDot:2
+3 SET RAI=RAI+1
+4 SET RAIN=$EXTRACT(RAIN,1,$LENGTH(RAIN)-$LENGTH(RAI))_RAI
+5 SET ^TMP($JOB,"RAE3",RADFN,RACIEN,RAPROC,RAIN)=" "_$GET(^RADPT(RADFN,"DT",RAINVXDT,"P",RACIEN,"H",Z,0))
End DoDot:2
End DoDot:1
+6 QUIT
