- RAHLO ;HIRMFO/GJC - Process data set from the bridge program ; Aug 15, 2024@11:49:39
- ;;5.0;Radiology/Nuclear Medicine;**4,8,27,55,66,84,94,106,144,162,165,218**;Mar 16, 1998;Build 1
- ; 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=$P($G(^RARPT(RARPT,0)),"^")_": Cannot add addendum to a non-verified report." Q ;P94 & P218
- ;DO block below updated by patches 94 & 218
- I $D(^RARPT(RARPT,0)),(($P(^(0),"^",5)="V")!($P(^(0),"^",5)="EF")),('$D(RADENDUM)#2) D Q
- .S RAERR=$P($G(^RARPT(RARPT,0)),"^")_": Report already on file."
- .Q
- ;
- 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=$P($G(^RARPT(RARPT,0)),"^")_": Duplicate Addendum" Q ;P218
- ; 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 9178 printed Mar 13, 2025@21:40:05 Page 2
- RAHLO ;HIRMFO/GJC - Process data set from the bridge program ; Aug 15, 2024@11:49:39
- +1 ;;5.0;Radiology/Nuclear Medicine;**4,8,27,55,66,84,94,106,144,162,165,218**;Mar 16, 1998;Build 1
- +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 ;
- +30 IF $DATA(^RARPT(RARPT,0))
- IF ($PIECE(^(0),"^",5)'="V")
- IF ($DATA(RADENDUM)#2)
- Begin DoDot:1
- +31 ;P94 & P218
- SET RAERR=$PIECE($GET(^RARPT(RARPT,0)),"^")_": Cannot add addendum to a non-verified report."
- QUIT
- End DoDot:1
- QUIT
- +32 ;DO block below updated by patches 94 & 218
- +33 IF $DATA(^RARPT(RARPT,0))
- IF (($PIECE(^(0),"^",5)="V")!($PIECE(^(0),"^",5)="EF"))
- IF ('$DATA(RADENDUM)#2)
- Begin DoDot:1
- +34 SET RAERR=$PIECE($GET(^RARPT(RARPT,0)),"^")_": Report already on file."
- +35 QUIT
- End DoDot:1
- QUIT
- +36 ;
- +37 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
- +38 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))
- +39 ; 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
- +40 ; 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
- +41 ;P218
- IF $DATA(RADENDUM)#2
- DO CKDUPA^RAHLO4
- IF RADUPA
- SET RAERR=$PIECE($GET(^RARPT(RARPT,0)),"^")_": Duplicate Addendum"
- QUIT
- +42 ; check resident and staff
- +43 NEW X1,X2,X3
- SET X2=0
- SET X3=""
- +44 IF '$GET(RATELE)
- IF +$GET(^TMP("RARPT-REC",$JOB,RASUB,"RARESIDENT"))!(+$GET(^("RASTAFF")))
- Begin DoDot:1
- +45 SET X1=+$GET(^TMP("RARPT-REC",$JOB,RASUB,"RARESIDENT"))
- +46 IF X1
- Begin DoDot:2
- +47 IF '$DATA(^VA(200,"ARC","R",X1))
- IF '$DATA(^VA(200,"ARC","S",X1))
- SET X2=1
- +48 IF $PIECE($GET(^VA(200,X1,"RA")),"^",3)
- IF $PIECE(^("RA"),"^",3)'>$$DT^XLFDT
- SET X2=X2+2
- +49 IF X2=1
- SET X3=$EXTRACT($PIECE($GET(^VA(200,X1,0)),"^"),1,20)_" is not class'd as Resident or Staff"
- +50 IF X2=2
- SET X3=$PIECE($GET(^VA(200,X1,0)),"^")_"'s INACTIVE DATE is past"
- +51 IF X2=3
- SET X3=$PIECE($GET(^VA(200,X1,0)),"^")_" is not class'd as resident and past INACTIVE DATE"
- +52 IF X3]""
- SET RAERR=X3
- End DoDot:2
- +53 SET X2=0
- SET X3=""
- SET X1=+$GET(^TMP("RARPT-REC",$JOB,RASUB,"RASTAFF"))
- +54 IF X1
- Begin DoDot:2
- +55 IF '$DATA(^VA(200,"ARC","S",X1))
- SET X2=1
- +56 IF $PIECE($GET(^VA(200,X1,"RA")),"^",3)
- IF $PIECE(^("RA"),"^",3)'>$$DT^XLFDT
- SET X2=X2+2
- +57 IF X2=1
- SET X3=$EXTRACT($PIECE($GET(^VA(200,X1,0)),"^"),1,20)_" is not class'd as staff"
- +58 IF X2=2
- SET X3=$PIECE($GET(^VA(200,X1,0)),"^")_"'s INACTIVE DATE is past"
- +59 IF X2=3
- SET X3=$PIECE($GET(^VA(200,X1,0)),"^")_" is not class'd as staff and past INACTIVE DATE"
- +60 IF X3]""
- SET RAERR=$SELECT($GET(RAERR)]"":RAERR_", ",1:"")_X3
- End DoDot:2
- +61 QUIT
- End DoDot:1
- if $GET(RAERR)]""
- QUIT
- +62 ; raesig is in alphanumeric format, so shouldn't use $g of it here
- +63 ; check if provider can verify report
- IF ($GET(RAESIG)]"")!($GET(RAVERF))
- if '$GET(RATELE)
- DO VERCHK^RAHLO3
- +64 ; if verifier fails checks,
- +65 ; quit only if vendor is non-kurzweil,
- +66 ; if vendor is kurzweil, continue on by deleting raerr, raverf
- +67 IF $DATA(RAERR)
- if $GET(^TMP("RARPT-REC",$JOB,RASUB,"VENDOR"))'="KURZWEIL"
- QUIT
- KILL RAERR,RAVERF
- +68 SET RAIMGTY=$$IMGTY^RAUTL12("l",RAMLC)
- IF '$LENGTH(RAIMGTY)
- SET RAERR="No Imaging Type for Location where exam was performed"
- QUIT
- +69 ;clear secondary dx array because RAHLO2 may not be called
- KILL RASECDX
- +70 ; 09/07/2005 108405 KAM- Removed ('$D(RADENDUM)#2) from next line
- +71 ;Patch 84
- IF $GET(RATELE)
- IF '$DATA(RADENDUM)
- IF '$DATA(^TMP("RARPT-REC",$JOB,RASUB,"RADX"))
- Begin DoDot:1
- +72 IF RASTAT="R"
- if $DATA(RATELEDR)
- SET ^TMP("RARPT-REC",$JOB,RASUB,"RADX",1)=RATELEDR
- QUIT
- +73 if $DATA(RATELEDF)
- SET ^TMP("RARPT-REC",$JOB,RASUB,"RADX",1)=RATELEDF
- End DoDot:1
- +74 ; DX code check took out - &('$D(RADENDUM)#2)
- if $DATA(^TMP("RARPT-REC",$JOB,RASUB,"RADX"))
- DO DIAG^RAHLO2
- if $DATA(RAERR)
- QUIT
- +75 ; edit sec Dx codes if they exist for non-addendums
- +76 ; 09/07/2005 108405 KAM - Removed ('$D(RADENDUM)#2)from next line
- +77 IF $DATA(RASECDX)
- DO SECDX^RAHLO2
- if $DATA(RAERR)
- QUIT
- +78 SET B=0
- FOR A="I","R"
- Begin DoDot:1
- +79 ; no rpt text
- if A="R"&('$DATA(^TMP("RARPT-REC",$JOB,RASUB,"RATXT")))
- QUIT
- +80 ; no imp text
- if A="I"&('$DATA(^TMP("RARPT-REC",$JOB,RASUB,"RAIMP")))
- QUIT
- +81 SET B=$$TEXT^RAHLO3(A)
- +82 if 'B
- SET RAERR=$$ERR^RAHLO2(A)
- +83 QUIT
- End DoDot:1
- if $DATA(RAERR)
- QUIT
- +84 ;
- +85 IF $GET(RATELE)
- IF $LENGTH($GET(RATELEPI))
- IF RATELEPI'?10N
- SET RAERR="Incorrect Teleradiologist's NPI: "_RATELEPI
- QUIT
- +86 ; determine the status of the report
- DO RPTSTAT^RAHLO3
- +87 ;P162 added error chk
- if $DATA(RAERR)#2
- QUIT
- +88 ;
- +89 ;new w/P106
- +90 ;p162 removed $D(RAERR)#2
- IF RARPT
- IF ($TEXT(EN^RARPTUT)'="")
- IF (RASTAT="VAQ")
- DO EN^RARPTUT
- QUIT
- +91 ;
- +92 ;new w/P162
- +93 IF $GET(RARPT)>0
- Begin DoDot:1
- +94 LOCK +^RARPT(RARPT):5
- +95 IF '$TEST
- SET RAERR="Lock of report record: "_RARPT_" failed."
- +96 QUIT
- End DoDot:1
- if $DATA(RAERR)#2
- QUIT
- +97 ;p165 - Need to unlock the report if accession is locked.
- +98 LOCK +^RADPT(RADFN,"DT",RADTI):60
- +99 IF '$TEST
- SET RAERR="Lock of study accession: "_$SELECT(RALONGCN'="":RALONGCN,1:"N/A")_" failed."
- Begin DoDot:1
- +100 IF $GET(RARPT)>0
- LOCK -^RARPT(RARPT)
- +101 QUIT
- End DoDot:1
- QUIT
- +102 DO FILE^RAHLO1
- +103 ;unlock the report & study unconditionally
- +104 LOCK -^RARPT(RARPT)
- LOCK -^RADPT(RADFN,"DT",RADTI)
- +105 QUIT
- +106 ;
