RAHLO ;HIRMFO/GJC-Process data set from the bridge program ; 20 Apr 2011 7:01 PM
;;5.0;Radiology/Nuclear Medicine;**4,8,27,55,66,84,94,1003**;Nov 01, 2010;Build 3
; 09/07/2005 Remedy call 108405 - KAM Allow Radiology to accept dx codes from Talk Technology
;
;Integration Agreements
;----------------------
;DT^DILF(2054); LOCK^DILF(2054); DEM^VADPT(10061); $$DT^XLFDT(10103)
;
EN1 ; Check the validity of the following data globals:
; Example: '^TMP("RARPT-REC",$J,RASUB,' where RASUB is a
; record in file 772.
;**************** Validates (if data present): ************************
; ^TMP("RARPT-REC",$J,RASUB,"RACNI")=case ien
; ^TMP("RARPT-REC",$J,RASUB,"RADATE")=date reported/entered/verified
; ^TMP("RARPT-REC",$J,RASUB,"RADFN")=patient ien
; ^TMP("RARPT-REC",$J,RASUB,"RADTI")=inverted exam date/time
; ^TMP("RARPT-REC",$J,RASUB,"RADX",#)=Dx codes (could be more than 1)
; ^TMP("RARPT-REC",$J,RASUB,"RAESIG")=Verifier's E-Sig (if present)
; ^TMP("RARPT-REC",$J,RASUB,"RAHIST")=Additional Clinical History
; ^TMP("RARPT-REC",$J,RASUB,"RAIMP",#)=Impression Text
; ^TMP("RARPT-REC",$J,RASUB,"RALONGCN")=Long Case Number
; ^TMP("RARPT-REC",$J,RASUB,"RASSN")=Patient SSN
; ^TMP("RARPT-REC",$J,RASUB,"RASTAT")=A, F or R (amend, final or prelim)
; ^TMP("RARPT-REC",$J,RASUB,"RATXT",#)=Report Text
; ^TMP("RARPT-REC",$J,RASUB,"VENDOR")=vendor
; ^TMP("RARPT-REC",$J,RASUB,"RAVERF")=Verifier ien
; ^TMP("RARPT-REC",$J,RASUB,"RATRANSCRIPT")=transcriptionist (optional)
; ^TMP("RARPT-REC",$J,RASUB,"RASTAFF")=Primary staff
; ^TMP("RARPT-REC",$J,RASUB,"RARESIDENT")=Primary resident
; ^TMP("RARPT-REC",$J,RASUB,"RAWHOCHANGE")=Who changed status to Verify
;**********************************************************************
K RAERR S RAQUIET=1
; Check if the minimum data set exists.
I '$D(^TMP("RARPT-REC",$J,RASUB,"RACNI")) S RAERR="Missing Case Number" Q
I '$D(^TMP("RARPT-REC",$J,RASUB,"RADFN")) S RAERR="Internal Patient ID Missing" Q
I '$D(^TMP("RARPT-REC",$J,RASUB,"RADTI")) S RAERR="Missing Exam Date" Q
I '$D(^TMP("RARPT-REC",$J,RASUB,"RALONGCN")) S RAERR="Missing Exam Date and/or Case Number" Q
I '$D(^TMP("RARPT-REC",$J,RASUB,"RASSN")) S RAERR="Missing Patient ID" Q
D CHECK ; check the validity of our data.
XIT ; Kill and quit
K A,B,DFN,K,RACNI,RADX,RADENDUM,RADFN,RADTI,RADUZ,RAIMGTY,RALONGCN,RAMDIV,RAMDV,RAMLC,RAQUIET,RARPT,RARPTSTS,RASSN,RAVLDT,X,Y,RATRANSC
Q
CHECK ; Check if our data is valid.
S RACNI=$G(^TMP("RARPT-REC",$J,RASUB,"RACNI"))
S RADATE=$G(^TMP("RARPT-REC",$J,RASUB,"RADATE"))
S RADFN=$G(^TMP("RARPT-REC",$J,RASUB,"RADFN"))
S RADTI=$G(^TMP("RARPT-REC",$J,RASUB,"RADTI"))
S RALONGCN=$G(^TMP("RARPT-REC",$J,RASUB,"RALONGCN"))
S RASSN=$G(^TMP("RARPT-REC",$J,RASUB,"RASSN"))
;
;IHS/BJI/DAY - Patch 1003 - Limit incoming provider field to IEN
;S (RAVERF,RADUZ)=$G(^TMP("RARPT-REC",$J,RASUB,"RAVERF"))
S (RAVERF,RADUZ)=+$G(^TMP("RARPT-REC",$J,RASUB,"RAVERF"))
I RAVERF=0 S (RAVERF,RADUZ)=""
;End patch
;
S RATRANSC=$G(^TMP("RARPT-REC",$J,RASUB,"RATRANSCRIPT"))
S RASTAT=$G(^TMP("RARPT-REC",$J,RASUB,"RASTAT")) I RASTAT="A" S RADENDUM=""
I $D(^TMP("RARPT-REC",$J,RASUB,"RAESIG")) S RAESIG=$G(^("RAESIG"))
I $D(^TMP("RARPT-REC",$J,RASUB,"RAIMP")) D IMPTXT^RAHLO2
I RADATE']"" S RAERR="Missing report date" Q
I RADFN']"" S RAERR="Missing Internal Patient ID" Q
I RACNI']"" S RAERR="Missing Case Number" Q
I RADTI']"" S RAERR="Missing Exam Date" Q
D DT^DILF("ET",RADATE,.RAVLDT)
S:RAVLDT=-1 RAERR="Invalid report date" Q:$D(RAERR)
K VA,VADM,VAERR S DFN=RADFN D DEM^VADPT
I VADM(1)']"" S RAERR="Unknown Internal patient identifier" K VA,VADM,VAERR Q
;
;IHS/BJI/DAY - Patch 1003 - Don't abort if no incoming SSN (infants)
;I RASSN'=$P(VADM(2),"^") S RAERR="Internal patient identifier and SSN don't match" K VA,VADM,VAERR Q
I RASSN]"",RASSN'=$P(VADM(2),"^") S RAERR="Internal patient identifier and SSN don't match" K VA,VADM,VAERR Q
;End patch
;
I '$D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))!(RALONGCN']"") D Q
. S RAERR="Invalid Exam Date and/or Case Number"
. Q
D EDTCHK^RAHLQ ; is user allowed to edit report for a cancelled case?
I RARPT=1 S RAERR="Report for CANCELLED case not permitted." Q
I RARPT=2 S RAERR="Please use VISTA to edit CANCELLED printset cases." Q
S RARPT=+$P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),"^",17)
I '$D(^RARPT(RARPT,0)),($D(RADENDUM)#2) S RAERR="Can't add addendum, no report" Q
I $D(^RARPT(RARPT,0)),($P(^(0),"^",5)'="V"),($D(RADENDUM)#2) D Q
.S RAERR="Can't add addendum to a report that is not verified." Q ;P94
;
I $D(^RARPT(RARPT,0)),(($P(^(0),"^",5)="V")!($P(^(0),"^",5)="EF")),('$D(RADENDUM)#2) D Q
.S RAERR="Report already on file" Q ;P94
;
I ($D(RADENDUM)#2),'$O(^TMP("RARPT-REC",$J,RASUB,"RAIMP",0)),'$O(^TMP("RARPT-REC",$J,RASUB,"RATXT",0)) S RAERR="Missing addendum report/impression text" Q
I $D(^RADPT(RADFN,"DT",RADTI,0)) S RAMDIV=^(0),RAMLC=+$P(RAMDIV,"^",4),RAMDIV=+$P(RAMDIV,"^",3),RAMDV=$S($D(^RA(79,RAMDIV,.1)):^(.1),1:""),RAMDV=$S(RAMDV="":RAMDV,1:$TR(RAMDV,"YyNn",1100))
I '($D(RADENDUM)#2) I $P(RAMDV,"^",16),('$D(^TMP("RARPT-REC",$J,RASUB,"RAIMP"))) S RAERR="Missing Impression Text" Q ; impression req'd for this division
I ($D(RADENDUM)#2),($D(^RARPT(RARPT,0))#2),($P(RAMDV,"^",16)),('$O(^RARPT(RARPT,"I",0))),('$D(^TMP("RARPT-REC",$J,RASUB,"RAIMP"))) S RAERR="Impression Text missing for current record." Q ; impression req'd for this division
I $D(RADENDUM)#2 D CKDUPA^RAHLO4 I RADUPA S RAERR="Duplicate Addendum" Q
; check resident and staff
N X1,X2,X3 S X2=0,X3=""
I '$G(RATELE),+$G(^TMP("RARPT-REC",$J,RASUB,"RARESIDENT"))!(+$G(^("RASTAFF"))) D Q:$G(RAERR)]""
. S X1=+$G(^TMP("RARPT-REC",$J,RASUB,"RARESIDENT"))
. I X1 D
.. I '$D(^VA(200,"ARC","R",X1)),'$D(^VA(200,"ARC","S",X1)) S X2=1
.. I $P($G(^VA(200,X1,"RA")),"^",3),$P(^("RA"),"^",3)'>$$DT^XLFDT S X2=X2+2
.. I X2=1 S X3=$E($P($G(^VA(200,X1,0)),"^"),1,20)_" is not class'd as Resident or Staff"
.. I X2=2 S X3=$P($G(^VA(200,X1,0)),"^")_"'s INACTIVE DATE is past"
.. I X2=3 S X3=$P($G(^VA(200,X1,0)),"^")_" is not class'd as resident and past INACTIVE DATE"
.. I X3]"" S RAERR=X3
. S X2=0,X3="" S X1=+$G(^TMP("RARPT-REC",$J,RASUB,"RASTAFF"))
. I X1 D
.. ;
.. ;IHS/BJI/DAY - Patch 1003 - Allow residents as verifiers
.. ;I '$D(^VA(200,"ARC","S",X1)) S X2=1
.. I '$D(^VA(200,"ARC","S",X1)),'$D(^VA(200,"ARC","R",X1)) S X2=1
.. ;End patch
.. ;
.. I $P($G(^VA(200,X1,"RA")),"^",3),$P(^("RA"),"^",3)'>$$DT^XLFDT S X2=X2+2
.. I X2=1 S X3=$E($P($G(^VA(200,X1,0)),"^"),1,20)_" is not class'd as staff"
.. I X2=2 S X3=$P($G(^VA(200,X1,0)),"^")_"'s INACTIVE DATE is past"
.. I X2=3 S X3=$P($G(^VA(200,X1,0)),"^")_" is not class'd as staff and past INACTIVE DATE"
.. I X3]"" S RAERR=$S($G(RAERR)]"":RAERR_", ",1:"")_X3
. Q
; raesig is in alphanumeric format, so shouldn't use $g of it here
I ($G(RAESIG)]"")!($G(RAVERF)) D:'$G(RATELE) VERCHK^RAHLO3 ; check if provider can verify report
; if verifier fails checks,
; quit only if vendor is non-kurzweil,
; if vendor is kurzweil, continue on by deleting raerr, raverf
I $D(RAERR) Q:$G(^TMP("RARPT-REC",$J,RASUB,"VENDOR"))'="KURZWEIL" K RAERR,RAVERF
S RAIMGTY=$$IMGTY^RAUTL12("l",RAMLC) I '$L(RAIMGTY) S RAERR="No Imaging Type for Location where exam was performed" Q
K RASECDX ;clear secondary dx array because RAHLO2 may not be called
; 09/07/2005 108405 KAM- Removed ('$D(RADENDUM)#2) from next line
I $G(RATELE),'$D(RADENDUM),'$D(^TMP("RARPT-REC",$J,RASUB,"RADX")) D ;Patch 84
.I RASTAT="R" S:$D(RATELEDR) ^TMP("RARPT-REC",$J,RASUB,"RADX",1)=RATELEDR Q
.S:$D(RATELEDF) ^TMP("RARPT-REC",$J,RASUB,"RADX",1)=RATELEDF
D:$D(^TMP("RARPT-REC",$J,RASUB,"RADX")) DIAG^RAHLO2 Q:$D(RAERR) ; DX code check took out - &('$D(RADENDUM)#2)
; edit sec Dx codes if they exist for non-addendums
; 09/07/2005 108405 KAM - Removed ('$D(RADENDUM)#2)from next line
I $D(RASECDX) D SECDX^RAHLO2 Q:$D(RAERR)
S B=0 F A="I","R" D Q:$D(RAERR)
. Q:A="R"&('$D(^TMP("RARPT-REC",$J,RASUB,"RATXT"))) ; no rpt text
. Q:A="I"&('$D(^TMP("RARPT-REC",$J,RASUB,"RAIMP"))) ; no imp text
. S B=$$TEXT^RAHLO3(A)
. S:'B RAERR=$$ERR^RAHLO2(A)
. Q
;
I $G(RATELE),$L($G(RATELEPI)),RATELEPI'?10N S RAERR="Incorrect Teleradiologist's NPI: "_RATELEPI Q
D RPTSTAT^RAHLO3 ; determine the status of the report
;
;new w/P94
D FILE^RAHLO1:'($D(RAERR)#2)
Q
;
RAHLO ;HIRMFO/GJC-Process data set from the bridge program ; 20 Apr 2011 7:01 PM
+1 ;;5.0;Radiology/Nuclear Medicine;**4,8,27,55,66,84,94,1003**;Nov 01, 2010;Build 3
+2 ; 09/07/2005 Remedy call 108405 - KAM Allow Radiology to accept dx codes from Talk Technology
+3 ;
+4 ;Integration Agreements
+5 ;----------------------
+6 ;DT^DILF(2054); LOCK^DILF(2054); DEM^VADPT(10061); $$DT^XLFDT(10103)
+7 ;
EN1 ; Check the validity of the following data globals:
+1 ; Example: '^TMP("RARPT-REC",$J,RASUB,' where RASUB is a
+2 ; record in file 772.
+3 ;**************** Validates (if data present): ************************
+4 ; ^TMP("RARPT-REC",$J,RASUB,"RACNI")=case ien
+5 ; ^TMP("RARPT-REC",$J,RASUB,"RADATE")=date reported/entered/verified
+6 ; ^TMP("RARPT-REC",$J,RASUB,"RADFN")=patient ien
+7 ; ^TMP("RARPT-REC",$J,RASUB,"RADTI")=inverted exam date/time
+8 ; ^TMP("RARPT-REC",$J,RASUB,"RADX",#)=Dx codes (could be more than 1)
+9 ; ^TMP("RARPT-REC",$J,RASUB,"RAESIG")=Verifier's E-Sig (if present)
+10 ; ^TMP("RARPT-REC",$J,RASUB,"RAHIST")=Additional Clinical History
+11 ; ^TMP("RARPT-REC",$J,RASUB,"RAIMP",#)=Impression Text
+12 ; ^TMP("RARPT-REC",$J,RASUB,"RALONGCN")=Long Case Number
+13 ; ^TMP("RARPT-REC",$J,RASUB,"RASSN")=Patient SSN
+14 ; ^TMP("RARPT-REC",$J,RASUB,"RASTAT")=A, F or R (amend, final or prelim)
+15 ; ^TMP("RARPT-REC",$J,RASUB,"RATXT",#)=Report Text
+16 ; ^TMP("RARPT-REC",$J,RASUB,"VENDOR")=vendor
+17 ; ^TMP("RARPT-REC",$J,RASUB,"RAVERF")=Verifier ien
+18 ; ^TMP("RARPT-REC",$J,RASUB,"RATRANSCRIPT")=transcriptionist (optional)
+19 ; ^TMP("RARPT-REC",$J,RASUB,"RASTAFF")=Primary staff
+20 ; ^TMP("RARPT-REC",$J,RASUB,"RARESIDENT")=Primary resident
+21 ; ^TMP("RARPT-REC",$J,RASUB,"RAWHOCHANGE")=Who changed status to Verify
+22 ;**********************************************************************
+23 KILL RAERR
SET RAQUIET=1
+24 ; Check if the minimum data set exists.
+25 IF '$DATA(^TMP("RARPT-REC",$JOB,RASUB,"RACNI"))
SET RAERR="Missing Case Number"
QUIT
+26 IF '$DATA(^TMP("RARPT-REC",$JOB,RASUB,"RADFN"))
SET RAERR="Internal Patient ID Missing"
QUIT
+27 IF '$DATA(^TMP("RARPT-REC",$JOB,RASUB,"RADTI"))
SET RAERR="Missing Exam Date"
QUIT
+28 IF '$DATA(^TMP("RARPT-REC",$JOB,RASUB,"RALONGCN"))
SET RAERR="Missing Exam Date and/or Case Number"
QUIT
+29 IF '$DATA(^TMP("RARPT-REC",$JOB,RASUB,"RASSN"))
SET RAERR="Missing Patient ID"
QUIT
+30 ; check the validity of our data.
DO CHECK
XIT ; Kill and quit
+1 KILL A,B,DFN,K,RACNI,RADX,RADENDUM,RADFN,RADTI,RADUZ,RAIMGTY,RALONGCN,RAMDIV,RAMDV,RAMLC,RAQUIET,RARPT,RARPTSTS,RASSN,RAVLDT,X,Y,RATRANSC
+2 QUIT
CHECK ; Check if our data is valid.
+1 SET RACNI=$GET(^TMP("RARPT-REC",$JOB,RASUB,"RACNI"))
+2 SET RADATE=$GET(^TMP("RARPT-REC",$JOB,RASUB,"RADATE"))
+3 SET RADFN=$GET(^TMP("RARPT-REC",$JOB,RASUB,"RADFN"))
+4 SET RADTI=$GET(^TMP("RARPT-REC",$JOB,RASUB,"RADTI"))
+5 SET RALONGCN=$GET(^TMP("RARPT-REC",$JOB,RASUB,"RALONGCN"))
+6 SET RASSN=$GET(^TMP("RARPT-REC",$JOB,RASUB,"RASSN"))
+7 ;
+8 ;IHS/BJI/DAY - Patch 1003 - Limit incoming provider field to IEN
+9 ;S (RAVERF,RADUZ)=$G(^TMP("RARPT-REC",$J,RASUB,"RAVERF"))
+10 SET (RAVERF,RADUZ)=+$GET(^TMP("RARPT-REC",$JOB,RASUB,"RAVERF"))
+11 IF RAVERF=0
SET (RAVERF,RADUZ)=""
+12 ;End patch
+13 ;
+14 SET RATRANSC=$GET(^TMP("RARPT-REC",$JOB,RASUB,"RATRANSCRIPT"))
+15 SET RASTAT=$GET(^TMP("RARPT-REC",$JOB,RASUB,"RASTAT"))
IF RASTAT="A"
SET RADENDUM=""
+16 IF $DATA(^TMP("RARPT-REC",$JOB,RASUB,"RAESIG"))
SET RAESIG=$GET(^("RAESIG"))
+17 IF $DATA(^TMP("RARPT-REC",$JOB,RASUB,"RAIMP"))
DO IMPTXT^RAHLO2
+18 IF RADATE']""
SET RAERR="Missing report date"
QUIT
+19 IF RADFN']""
SET RAERR="Missing Internal Patient ID"
QUIT
+20 IF RACNI']""
SET RAERR="Missing Case Number"
QUIT
+21 IF RADTI']""
SET RAERR="Missing Exam Date"
QUIT
+22 DO DT^DILF("ET",RADATE,.RAVLDT)
+23 IF RAVLDT=-1
SET RAERR="Invalid report date"
IF $DATA(RAERR)
QUIT
+24 KILL VA,VADM,VAERR
SET DFN=RADFN
DO DEM^VADPT
+25 IF VADM(1)']""
SET RAERR="Unknown Internal patient identifier"
KILL VA,VADM,VAERR
QUIT
+26 ;
+27 ;IHS/BJI/DAY - Patch 1003 - Don't abort if no incoming SSN (infants)
+28 ;I RASSN'=$P(VADM(2),"^") S RAERR="Internal patient identifier and SSN don't match" K VA,VADM,VAERR Q
+29 IF RASSN]""
IF RASSN'=$PIECE(VADM(2),"^")
SET RAERR="Internal patient identifier and SSN don't match"
KILL VA,VADM,VAERR
QUIT
+30 ;End patch
+31 ;
+32 IF '$DATA(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))!(RALONGCN']"")
Begin DoDot:1
+33 SET RAERR="Invalid Exam Date and/or Case Number"
+34 QUIT
End DoDot:1
QUIT
+35 ; is user allowed to edit report for a cancelled case?
DO EDTCHK^RAHLQ
+36 IF RARPT=1
SET RAERR="Report for CANCELLED case not permitted."
QUIT
+37 IF RARPT=2
SET RAERR="Please use VISTA to edit CANCELLED printset cases."
QUIT
+38 SET RARPT=+$PIECE(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),"^",17)
+39 IF '$DATA(^RARPT(RARPT,0))
IF ($DATA(RADENDUM)#2)
SET RAERR="Can't add addendum, no report"
QUIT
+40 IF $DATA(^RARPT(RARPT,0))
IF ($PIECE(^(0),"^",5)'="V")
IF ($DATA(RADENDUM)#2)
Begin DoDot:1
+41 ;P94
SET RAERR="Can't add addendum to a report that is not verified."
QUIT
End DoDot:1
QUIT
+42 ;
+43 IF $DATA(^RARPT(RARPT,0))
IF (($PIECE(^(0),"^",5)="V")!($PIECE(^(0),"^",5)="EF"))
IF ('$DATA(RADENDUM)#2)
Begin DoDot:1
+44 ;P94
SET RAERR="Report already on file"
QUIT
End DoDot:1
QUIT
+45 ;
+46 IF ($DATA(RADENDUM)#2)
IF '$ORDER(^TMP("RARPT-REC",$JOB,RASUB,"RAIMP",0))
IF '$ORDER(^TMP("RARPT-REC",$JOB,RASUB,"RATXT",0))
SET RAERR="Missing addendum report/impression text"
QUIT
+47 IF $DATA(^RADPT(RADFN,"DT",RADTI,0))
SET RAMDIV=^(0)
SET RAMLC=+$PIECE(RAMDIV,"^",4)
SET RAMDIV=+$PIECE(RAMDIV,"^",3)
SET RAMDV=$SELECT($DATA(^RA(79,RAMDIV,.1)):^(.1),1:"")
SET RAMDV=$SELECT(RAMDV="":RAMDV,1:$TRANSLATE(RAMDV,"YyNn",1100))
+48 ; impression req'd for this division
IF '($DATA(RADENDUM)#2)
IF $PIECE(RAMDV,"^",16)
IF ('$DATA(^TMP("RARPT-REC",$JOB,RASUB,"RAIMP")))
SET RAERR="Missing Impression Text"
QUIT
+49 ; impression req'd for this division
IF ($DATA(RADENDUM)#2)
IF ($DATA(^RARPT(RARPT,0))#2)
IF ($PIECE(RAMDV,"^",16))
IF ('$ORDER(^RARPT(RARPT,"I",0)))
IF ('$DATA(^TMP("RARPT-REC",$JOB,RASUB,"RAIMP")))
SET RAERR="Impression Text missing for current record."
QUIT
+50 IF $DATA(RADENDUM)#2
DO CKDUPA^RAHLO4
IF RADUPA
SET RAERR="Duplicate Addendum"
QUIT
+51 ; check resident and staff
+52 NEW X1,X2,X3
SET X2=0
SET X3=""
+53 IF '$GET(RATELE)
IF +$GET(^TMP("RARPT-REC",$JOB,RASUB,"RARESIDENT"))!(+$GET(^("RASTAFF")))
Begin DoDot:1
+54 SET X1=+$GET(^TMP("RARPT-REC",$JOB,RASUB,"RARESIDENT"))
+55 IF X1
Begin DoDot:2
+56 IF '$DATA(^VA(200,"ARC","R",X1))
IF '$DATA(^VA(200,"ARC","S",X1))
SET X2=1
+57 IF $PIECE($GET(^VA(200,X1,"RA")),"^",3)
IF $PIECE(^("RA"),"^",3)'>$$DT^XLFDT
SET X2=X2+2
+58 IF X2=1
SET X3=$EXTRACT($PIECE($GET(^VA(200,X1,0)),"^"),1,20)_" is not class'd as Resident or Staff"
+59 IF X2=2
SET X3=$PIECE($GET(^VA(200,X1,0)),"^")_"'s INACTIVE DATE is past"
+60 IF X2=3
SET X3=$PIECE($GET(^VA(200,X1,0)),"^")_" is not class'd as resident and past INACTIVE DATE"
+61 IF X3]""
SET RAERR=X3
End DoDot:2
+62 SET X2=0
SET X3=""
SET X1=+$GET(^TMP("RARPT-REC",$JOB,RASUB,"RASTAFF"))
+63 IF X1
Begin DoDot:2
+64 ;
+65 ;IHS/BJI/DAY - Patch 1003 - Allow residents as verifiers
+66 ;I '$D(^VA(200,"ARC","S",X1)) S X2=1
+67 IF '$DATA(^VA(200,"ARC","S",X1))
IF '$DATA(^VA(200,"ARC","R",X1))
SET X2=1
+68 ;End patch
+69 ;
+70 IF $PIECE($GET(^VA(200,X1,"RA")),"^",3)
IF $PIECE(^("RA"),"^",3)'>$$DT^XLFDT
SET X2=X2+2
+71 IF X2=1
SET X3=$EXTRACT($PIECE($GET(^VA(200,X1,0)),"^"),1,20)_" is not class'd as staff"
+72 IF X2=2
SET X3=$PIECE($GET(^VA(200,X1,0)),"^")_"'s INACTIVE DATE is past"
+73 IF X2=3
SET X3=$PIECE($GET(^VA(200,X1,0)),"^")_" is not class'd as staff and past INACTIVE DATE"
+74 IF X3]""
SET RAERR=$SELECT($GET(RAERR)]"":RAERR_", ",1:"")_X3
End DoDot:2
+75 QUIT
End DoDot:1
IF $GET(RAERR)]""
QUIT
+76 ; raesig is in alphanumeric format, so shouldn't use $g of it here
+77 ; check if provider can verify report
IF ($GET(RAESIG)]"")!($GET(RAVERF))
IF '$GET(RATELE)
DO VERCHK^RAHLO3
+78 ; if verifier fails checks,
+79 ; quit only if vendor is non-kurzweil,
+80 ; if vendor is kurzweil, continue on by deleting raerr, raverf
+81 IF $DATA(RAERR)
IF $GET(^TMP("RARPT-REC",$JOB,RASUB,"VENDOR"))'="KURZWEIL"
QUIT
KILL RAERR,RAVERF
+82 SET RAIMGTY=$$IMGTY^RAUTL12("l",RAMLC)
IF '$LENGTH(RAIMGTY)
SET RAERR="No Imaging Type for Location where exam was performed"
QUIT
+83 ;clear secondary dx array because RAHLO2 may not be called
KILL RASECDX
+84 ; 09/07/2005 108405 KAM- Removed ('$D(RADENDUM)#2) from next line
+85 ;Patch 84
IF $GET(RATELE)
IF '$DATA(RADENDUM)
IF '$DATA(^TMP("RARPT-REC",$JOB,RASUB,"RADX"))
Begin DoDot:1
+86 IF RASTAT="R"
IF $DATA(RATELEDR)
SET ^TMP("RARPT-REC",$JOB,RASUB,"RADX",1)=RATELEDR
QUIT
+87 IF $DATA(RATELEDF)
SET ^TMP("RARPT-REC",$JOB,RASUB,"RADX",1)=RATELEDF
End DoDot:1
+88 ; DX code check took out - &('$D(RADENDUM)#2)
IF $DATA(^TMP("RARPT-REC",$JOB,RASUB,"RADX"))
DO DIAG^RAHLO2
IF $DATA(RAERR)
QUIT
+89 ; edit sec Dx codes if they exist for non-addendums
+90 ; 09/07/2005 108405 KAM - Removed ('$D(RADENDUM)#2)from next line
+91 IF $DATA(RASECDX)
DO SECDX^RAHLO2
IF $DATA(RAERR)
QUIT
+92 SET B=0
FOR A="I","R"
Begin DoDot:1
+93 ; no rpt text
IF A="R"&('$DATA(^TMP("RARPT-REC",$JOB,RASUB,"RATXT")))
QUIT
+94 ; no imp text
IF A="I"&('$DATA(^TMP("RARPT-REC",$JOB,RASUB,"RAIMP")))
QUIT
+95 SET B=$$TEXT^RAHLO3(A)
+96 IF 'B
SET RAERR=$$ERR^RAHLO2(A)
+97 QUIT
End DoDot:1
IF $DATA(RAERR)
QUIT
+98 ;
+99 IF $GET(RATELE)
IF $LENGTH($GET(RATELEPI))
IF RATELEPI'?10N
SET RAERR="Incorrect Teleradiologist's NPI: "_RATELEPI
QUIT
+100 ; determine the status of the report
DO RPTSTAT^RAHLO3
+101 ;
+102 ;new w/P94
+103 IF '($DATA(RAERR)#2)
DO FILE^RAHLO1
+104 QUIT
+105 ;
