RAHLO ;HIRMFO/GJC-Process data set from the bridge program ; Jun 02, 2020@09:33:35
;;5.0;Radiology/Nuclear Medicine;**4,8,27,55,66,84,94,106,144,162,165**;Mar 16, 1998;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, C, F or R
; Note: we use 'F' for final and 'P' for preliminary as RESULT
; STATUS values for both the v2.3 & v2.4 HL7 interfaces.
; BUT: we use 'C' ('corrected') for the v2.4 interface &
; 'A' ('amended') for the v2.3 interface.
;
; Note: VAQ - added w/P106 study released back to VAMC
; for interpretation
;
; ^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
K RAQUIET,RARPT,RARPTSTS,RASSN,RAVLDT,X,Y,Z,RATRANSC,RAERRCHK,RAOR,RAPURGE,RARPTI,RASIUID
K RASN,RASSNVAL,RAST32,RASTAT,RASTI,RAZDAYCS,RAZDTE,RAZORD,RAZORD1,RAZPROC,RAZRXAM,RAZXAM
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"))
S (RAVERF,RADUZ)=$G(^TMP("RARPT-REC",$J,RASUB,"RAVERF"))
S RATRANSC=$G(^TMP("RARPT-REC",$J,RASUB,"RATRANSCRIPT"))
S RASTAT=$G(^TMP("RARPT-REC",$J,RASUB,"RASTAT")) I RASTAT="A"!(RASTAT="C") 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
I RASSN'=$P(VADM(2),"^") S RAERR="Internal patient identifier and SSN don't match" K VA,VADM,VAERR Q
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
.. I '$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 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
Q:$D(RAERR)#2 ;P162 added error chk
;
;new w/P106
I RARPT,($T(EN^RARPTUT)'=""),(RASTAT="VAQ") D EN^RARPTUT QUIT ;p162 removed $D(RAERR)#2
;
;new w/P162
I $G(RARPT)>0 D Q:$D(RAERR)#2
.L +^RARPT(RARPT):5
.I '$T S RAERR="Lock of report record: "_RARPT_" failed."
.Q
;p165 - Need to unlock the report if accession is locked.
L +^RADPT(RADFN,"DT",RADTI):60
I '$T S RAERR="Lock of study accession: "_$S(RALONGCN'="":RALONGCN,1:"N/A")_" failed." D Q
.I $G(RARPT)>0 L -^RARPT(RARPT)
.Q
D FILE^RAHLO1
;unlock the report & study unconditionally
L -^RARPT(RARPT) L -^RADPT(RADFN,"DT",RADTI)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAHLO 9031 printed Apr 09, 2024@21:37:20 Page 2
RAHLO ;HIRMFO/GJC-Process data set from the bridge program ; Jun 02, 2020@09:33:35
+1 ;;5.0;Radiology/Nuclear Medicine;**4,8,27,55,66,84,94,106,144,162,165**;Mar 16, 1998;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, C, F or R
+15 ; Note: we use 'F' for final and 'P' for preliminary as RESULT
+16 ; STATUS values for both the v2.3 & v2.4 HL7 interfaces.
+17 ; BUT: we use 'C' ('corrected') for the v2.4 interface &
+18 ; 'A' ('amended') for the v2.3 interface.
+19 ;
+20 ; Note: VAQ - added w/P106 study released back to VAMC
+21 ; for interpretation
+22 ;
+23 ; ^TMP("RARPT-REC",$J,RASUB,"RATXT",#)=Report Text
+24 ; ^TMP("RARPT-REC",$J,RASUB,"VENDOR")=vendor
+25 ; ^TMP("RARPT-REC",$J,RASUB,"RAVERF")=Verifier ien
+26 ; ^TMP("RARPT-REC",$J,RASUB,"RATRANSCRIPT")=transcriptionist (optional)
+27 ; ^TMP("RARPT-REC",$J,RASUB,"RASTAFF")=Primary staff
+28 ; ^TMP("RARPT-REC",$J,RASUB,"RARESIDENT")=Primary resident
+29 ; ^TMP("RARPT-REC",$J,RASUB,"RAWHOCHANGE")=Who changed status to Verify
+30 ;**********************************************************************
+31 KILL RAERR
SET RAQUIET=1
+32 ; Check if the minimum data set exists.
+33 IF '$DATA(^TMP("RARPT-REC",$JOB,RASUB,"RACNI"))
SET RAERR="Missing Case Number"
QUIT
+34 IF '$DATA(^TMP("RARPT-REC",$JOB,RASUB,"RADFN"))
SET RAERR="Internal Patient ID Missing"
QUIT
+35 IF '$DATA(^TMP("RARPT-REC",$JOB,RASUB,"RADTI"))
SET RAERR="Missing Exam Date"
QUIT
+36 IF '$DATA(^TMP("RARPT-REC",$JOB,RASUB,"RALONGCN"))
SET RAERR="Missing Exam Date and/or Case Number"
QUIT
+37 IF '$DATA(^TMP("RARPT-REC",$JOB,RASUB,"RASSN"))
SET RAERR="Missing Patient ID"
QUIT
+38 ; 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
+2 KILL RAQUIET,RARPT,RARPTSTS,RASSN,RAVLDT,X,Y,Z,RATRANSC,RAERRCHK,RAOR,RAPURGE,RARPTI,RASIUID
+3 KILL RASN,RASSNVAL,RAST32,RASTAT,RASTI,RAZDAYCS,RAZDTE,RAZORD,RAZORD1,RAZPROC,RAZRXAM,RAZXAM
+4 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 SET (RAVERF,RADUZ)=$GET(^TMP("RARPT-REC",$JOB,RASUB,"RAVERF"))
+8 SET RATRANSC=$GET(^TMP("RARPT-REC",$JOB,RASUB,"RATRANSCRIPT"))
+9 SET RASTAT=$GET(^TMP("RARPT-REC",$JOB,RASUB,"RASTAT"))
IF RASTAT="A"!(RASTAT="C")
SET RADENDUM=""
+10 IF $DATA(^TMP("RARPT-REC",$JOB,RASUB,"RAESIG"))
SET RAESIG=$GET(^("RAESIG"))
+11 IF $DATA(^TMP("RARPT-REC",$JOB,RASUB,"RAIMP"))
DO IMPTXT^RAHLO2
+12 IF RADATE']""
SET RAERR="Missing report date"
QUIT
+13 IF RADFN']""
SET RAERR="Missing Internal Patient ID"
QUIT
+14 IF RACNI']""
SET RAERR="Missing Case Number"
QUIT
+15 IF RADTI']""
SET RAERR="Missing Exam Date"
QUIT
+16 DO DT^DILF("ET",RADATE,.RAVLDT)
+17 if RAVLDT=-1
SET RAERR="Invalid report date"
if $DATA(RAERR)
QUIT
+18 KILL VA,VADM,VAERR
SET DFN=RADFN
DO DEM^VADPT
+19 IF VADM(1)']""
SET RAERR="Unknown Internal patient identifier"
KILL VA,VADM,VAERR
QUIT
+20 IF RASSN'=$PIECE(VADM(2),"^")
SET RAERR="Internal patient identifier and SSN don't match"
KILL VA,VADM,VAERR
QUIT
+21 IF '$DATA(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))!(RALONGCN']"")
Begin DoDot:1
+22 SET RAERR="Invalid Exam Date and/or Case Number"
+23 QUIT
End DoDot:1
QUIT
+24 ; is user allowed to edit report for a cancelled case?
DO EDTCHK^RAHLQ
+25 IF RARPT=1
SET RAERR="Report for CANCELLED case not permitted."
QUIT
+26 IF RARPT=2
SET RAERR="Please use VISTA to edit CANCELLED printset cases."
QUIT
+27 SET RARPT=+$PIECE(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),"^",17)
+28 IF '$DATA(^RARPT(RARPT,0))
IF ($DATA(RADENDUM)#2)
SET RAERR="Can't add addendum, no report"
QUIT
+29 IF $DATA(^RARPT(RARPT,0))
IF ($PIECE(^(0),"^",5)'="V")
IF ($DATA(RADENDUM)#2)
Begin DoDot:1
+30 ;P94
SET RAERR="Can't add addendum to a report that is not verified."
QUIT
End DoDot:1
QUIT
+31 ;
+32 IF $DATA(^RARPT(RARPT,0))
IF (($PIECE(^(0),"^",5)="V")!($PIECE(^(0),"^",5)="EF"))
IF ('$DATA(RADENDUM)#2)
Begin DoDot:1
+33 ;P94
SET RAERR="Report already on file"
QUIT
End DoDot:1
QUIT
+34 ;
+35 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
+36 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))
+37 ; 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
+38 ; 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
+39 IF $DATA(RADENDUM)#2
DO CKDUPA^RAHLO4
IF RADUPA
SET RAERR="Duplicate Addendum"
QUIT
+40 ; check resident and staff
+41 NEW X1,X2,X3
SET X2=0
SET X3=""
+42 IF '$GET(RATELE)
IF +$GET(^TMP("RARPT-REC",$JOB,RASUB,"RARESIDENT"))!(+$GET(^("RASTAFF")))
Begin DoDot:1
+43 SET X1=+$GET(^TMP("RARPT-REC",$JOB,RASUB,"RARESIDENT"))
+44 IF X1
Begin DoDot:2
+45 IF '$DATA(^VA(200,"ARC","R",X1))
IF '$DATA(^VA(200,"ARC","S",X1))
SET X2=1
+46 IF $PIECE($GET(^VA(200,X1,"RA")),"^",3)
IF $PIECE(^("RA"),"^",3)'>$$DT^XLFDT
SET X2=X2+2
+47 IF X2=1
SET X3=$EXTRACT($PIECE($GET(^VA(200,X1,0)),"^"),1,20)_" is not class'd as Resident or Staff"
+48 IF X2=2
SET X3=$PIECE($GET(^VA(200,X1,0)),"^")_"'s INACTIVE DATE is past"
+49 IF X2=3
SET X3=$PIECE($GET(^VA(200,X1,0)),"^")_" is not class'd as resident and past INACTIVE DATE"
+50 IF X3]""
SET RAERR=X3
End DoDot:2
+51 SET X2=0
SET X3=""
SET X1=+$GET(^TMP("RARPT-REC",$JOB,RASUB,"RASTAFF"))
+52 IF X1
Begin DoDot:2
+53 IF '$DATA(^VA(200,"ARC","S",X1))
SET X2=1
+54 IF $PIECE($GET(^VA(200,X1,"RA")),"^",3)
IF $PIECE(^("RA"),"^",3)'>$$DT^XLFDT
SET X2=X2+2
+55 IF X2=1
SET X3=$EXTRACT($PIECE($GET(^VA(200,X1,0)),"^"),1,20)_" is not class'd as staff"
+56 IF X2=2
SET X3=$PIECE($GET(^VA(200,X1,0)),"^")_"'s INACTIVE DATE is past"
+57 IF X2=3
SET X3=$PIECE($GET(^VA(200,X1,0)),"^")_" is not class'd as staff and past INACTIVE DATE"
+58 IF X3]""
SET RAERR=$SELECT($GET(RAERR)]"":RAERR_", ",1:"")_X3
End DoDot:2
+59 QUIT
End DoDot:1
if $GET(RAERR)]""
QUIT
+60 ; raesig is in alphanumeric format, so shouldn't use $g of it here
+61 ; check if provider can verify report
IF ($GET(RAESIG)]"")!($GET(RAVERF))
if '$GET(RATELE)
DO VERCHK^RAHLO3
+62 ; if verifier fails checks,
+63 ; quit only if vendor is non-kurzweil,
+64 ; if vendor is kurzweil, continue on by deleting raerr, raverf
+65 IF $DATA(RAERR)
if $GET(^TMP("RARPT-REC",$JOB,RASUB,"VENDOR"))'="KURZWEIL"
QUIT
KILL RAERR,RAVERF
+66 SET RAIMGTY=$$IMGTY^RAUTL12("l",RAMLC)
IF '$LENGTH(RAIMGTY)
SET RAERR="No Imaging Type for Location where exam was performed"
QUIT
+67 ;clear secondary dx array because RAHLO2 may not be called
KILL RASECDX
+68 ; 09/07/2005 108405 KAM- Removed ('$D(RADENDUM)#2) from next line
+69 ;Patch 84
IF $GET(RATELE)
IF '$DATA(RADENDUM)
IF '$DATA(^TMP("RARPT-REC",$JOB,RASUB,"RADX"))
Begin DoDot:1
+70 IF RASTAT="R"
if $DATA(RATELEDR)
SET ^TMP("RARPT-REC",$JOB,RASUB,"RADX",1)=RATELEDR
QUIT
+71 if $DATA(RATELEDF)
SET ^TMP("RARPT-REC",$JOB,RASUB,"RADX",1)=RATELEDF
End DoDot:1
+72 ; DX code check took out - &('$D(RADENDUM)#2)
if $DATA(^TMP("RARPT-REC",$JOB,RASUB,"RADX"))
DO DIAG^RAHLO2
if $DATA(RAERR)
QUIT
+73 ; edit sec Dx codes if they exist for non-addendums
+74 ; 09/07/2005 108405 KAM - Removed ('$D(RADENDUM)#2)from next line
+75 IF $DATA(RASECDX)
DO SECDX^RAHLO2
if $DATA(RAERR)
QUIT
+76 SET B=0
FOR A="I","R"
Begin DoDot:1
+77 ; no rpt text
if A="R"&('$DATA(^TMP("RARPT-REC",$JOB,RASUB,"RATXT")))
QUIT
+78 ; no imp text
if A="I"&('$DATA(^TMP("RARPT-REC",$JOB,RASUB,"RAIMP")))
QUIT
+79 SET B=$$TEXT^RAHLO3(A)
+80 if 'B
SET RAERR=$$ERR^RAHLO2(A)
+81 QUIT
End DoDot:1
if $DATA(RAERR)
QUIT
+82 ;
+83 IF $GET(RATELE)
IF $LENGTH($GET(RATELEPI))
IF RATELEPI'?10N
SET RAERR="Incorrect Teleradiologist's NPI: "_RATELEPI
QUIT
+84 ; determine the status of the report
DO RPTSTAT^RAHLO3
+85 ;P162 added error chk
if $DATA(RAERR)#2
QUIT
+86 ;
+87 ;new w/P106
+88 ;p162 removed $D(RAERR)#2
IF RARPT
IF ($TEXT(EN^RARPTUT)'="")
IF (RASTAT="VAQ")
DO EN^RARPTUT
QUIT
+89 ;
+90 ;new w/P162
+91 IF $GET(RARPT)>0
Begin DoDot:1
+92 LOCK +^RARPT(RARPT):5
+93 IF '$TEST
SET RAERR="Lock of report record: "_RARPT_" failed."
+94 QUIT
End DoDot:1
if $DATA(RAERR)#2
QUIT
+95 ;p165 - Need to unlock the report if accession is locked.
+96 LOCK +^RADPT(RADFN,"DT",RADTI):60
+97 IF '$TEST
SET RAERR="Lock of study accession: "_$SELECT(RALONGCN'="":RALONGCN,1:"N/A")_" failed."
Begin DoDot:1
+98 IF $GET(RARPT)>0
LOCK -^RARPT(RARPT)
+99 QUIT
End DoDot:1
QUIT
+100 DO FILE^RAHLO1
+101 ;unlock the report & study unconditionally
+102 LOCK -^RARPT(RARPT)
LOCK -^RADPT(RADFN,"DT",RADTI)
+103 QUIT
+104 ;
