- 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 ;
