- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAO7PC3 7450 printed Feb 19, 2025@00:04:04 Page 2
- 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