Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RAHLO

RAHLO.m

Go to the documentation of this file.
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
 ;