source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAHLO.m@ 808

Last change on this file since 808 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 7.7 KB
Line 
1RAHLO ;HIRMFO/GJC-Process data set from the bridge program ;11/18/97 12:13
2 ;;5.0;Radiology/Nuclear Medicine;**4,8,27,55,66,84**;Mar 16, 1998;Build 13
3 ; 09/07/2005 Remedy call 108405 - KAM Allow Radiology to accept dx codes from Talk Technology
4 ;
5 ;Integration Agreements
6 ;----------------------
7 ;DT^DILF(2054); LOCK^DILF(2054); DEM^VADPT(10061); $$DT^XLFDT(10103)
8 ;
9EN1 ; Check the validity of the following data globals:
10 ; Example: '^TMP("RARPT-REC",$J,RASUB,' where RASUB is a
11 ; record in file 772.
12 ;**************** Validates (if data present): ************************
13 ; ^TMP("RARPT-REC",$J,RASUB,"RACNI")=case ien
14 ; ^TMP("RARPT-REC",$J,RASUB,"RADATE")=date reported/entered/verified
15 ; ^TMP("RARPT-REC",$J,RASUB,"RADFN")=patient ien
16 ; ^TMP("RARPT-REC",$J,RASUB,"RADTI")=inverted exam date/time
17 ; ^TMP("RARPT-REC",$J,RASUB,"RADX",#)=Dx codes (could be more than 1)
18 ; ^TMP("RARPT-REC",$J,RASUB,"RAESIG")=Verifier's E-Sig (if present)
19 ; ^TMP("RARPT-REC",$J,RASUB,"RAHIST")=Additional Clinical History
20 ; ^TMP("RARPT-REC",$J,RASUB,"RAIMP",#)=Impression Text
21 ; ^TMP("RARPT-REC",$J,RASUB,"RALONGCN")=Long Case Number
22 ; ^TMP("RARPT-REC",$J,RASUB,"RASSN")=Patient SSN
23 ; ^TMP("RARPT-REC",$J,RASUB,"RASTAT")=A, F or R (amend, final or prelim)
24 ; ^TMP("RARPT-REC",$J,RASUB,"RATXT",#)=Report Text
25 ; ^TMP("RARPT-REC",$J,RASUB,"VENDOR")=vendor
26 ; ^TMP("RARPT-REC",$J,RASUB,"RAVERF")=Verifier ien
27 ; ^TMP("RARPT-REC",$J,RASUB,"RATRANSCRIPT")=transcriptionist (optional)
28 ; ^TMP("RARPT-REC",$J,RASUB,"RASTAFF")=Primary staff
29 ; ^TMP("RARPT-REC",$J,RASUB,"RARESIDENT")=Primary resident
30 ; ^TMP("RARPT-REC",$J,RASUB,"RAWHOCHANGE")=Who changed status to Verify
31 ;**********************************************************************
32 K RAERR S RAQUIET=1
33 ; Check if the minimum data set exists.
34 I '$D(^TMP("RARPT-REC",$J,RASUB,"RACNI")) S RAERR="Missing Case Number" Q
35 I '$D(^TMP("RARPT-REC",$J,RASUB,"RADFN")) S RAERR="Internal Patient ID Missing" Q
36 I '$D(^TMP("RARPT-REC",$J,RASUB,"RADTI")) S RAERR="Missing Exam Date" Q
37 I '$D(^TMP("RARPT-REC",$J,RASUB,"RALONGCN")) S RAERR="Missing Exam Date and/or Case Number" Q
38 I '$D(^TMP("RARPT-REC",$J,RASUB,"RASSN")) S RAERR="Missing Patient ID" Q
39 D CHECK ; check the validity of our data.
40XIT ; Kill and quit
41 K A,B,DFN,K,RACNI,RADX,RADENDUM,RADFN,RADTI,RADUZ,RAIMGTY,RALONGCN,RAMDIV,RAMDV,RAMLC,RAQUIET,RADPIECE,RARPT,RARPTSTS,RASSN,RAVLDT,X,Y,RATRANSC
42 Q
43CHECK ; Check if our data is valid.
44 S RACNI=$G(^TMP("RARPT-REC",$J,RASUB,"RACNI"))
45 S RADATE=$G(^TMP("RARPT-REC",$J,RASUB,"RADATE"))
46 S RADFN=$G(^TMP("RARPT-REC",$J,RASUB,"RADFN"))
47 S RADTI=$G(^TMP("RARPT-REC",$J,RASUB,"RADTI"))
48 S RALONGCN=$G(^TMP("RARPT-REC",$J,RASUB,"RALONGCN"))
49 S RASSN=$G(^TMP("RARPT-REC",$J,RASUB,"RASSN"))
50 S (RAVERF,RADUZ)=$G(^TMP("RARPT-REC",$J,RASUB,"RAVERF"))
51 S RATRANSC=$G(^TMP("RARPT-REC",$J,RASUB,"RATRANSCRIPT"))
52 S RASTAT=$G(^TMP("RARPT-REC",$J,RASUB,"RASTAT")) I RASTAT="A" S RADENDUM=""
53 I $D(^TMP("RARPT-REC",$J,RASUB,"RAESIG")) S RAESIG=$G(^("RAESIG"))
54 I $D(^TMP("RARPT-REC",$J,RASUB,"RAIMP")) D IMPTXT^RAHLO2
55 I RADATE']"" S RAERR="Missing report date" Q
56 I RADFN']"" S RAERR="Missing Internal Patient ID" Q
57 I RACNI']"" S RAERR="Missing Case Number" Q
58 I RADTI']"" S RAERR="Missing Exam Date" Q
59 D DT^DILF("ET",RADATE,.RAVLDT)
60 S:RAVLDT=-1 RAERR="Invalid report date" Q:$D(RAERR)
61 K VA,VADM,VAERR S DFN=RADFN D DEM^VADPT
62 I VADM(1)']"" S RAERR="Unknown Internal patient identifier" K VA,VADM,VAERR Q
63 I RASSN'=$P(VADM(2),"^") S RAERR="Internal patient identifier and SSN don't match" K VA,VADM,VAERR Q
64 I '$D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))!(RALONGCN']"") D Q
65 . S RAERR="Invalid Exam Date and/or Case Number"
66 . Q
67 D EDTCHK^RAHLQ ; is user allowed to edit report for a cancelled case?
68 I RARPT=1 S RAERR="Report for CANCELLED case not permitted." Q
69 I RARPT=2 S RAERR="Please use VISTA to edit CANCELLED printset cases." Q
70 S RARPT=+$P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),"^",17)
71 I '$D(^RARPT(RARPT,0)),($D(RADENDUM)#2) S RAERR="Can't add addendum, no report" Q
72 I $D(^RARPT(RARPT,0)),($P(^(0),"^",5)'="V"),($D(RADENDUM)#2) S RAERR="Can't add addendum to an unverified report" Q
73 I $D(^RARPT(RARPT,0)),$P(^(0),"^",5)="V",('$D(RADENDUM)#2) S RAERR="Report already on file" Q
74 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
75 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))
76 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
77 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
78 I $D(RADENDUM)#2 D CKDUPA^RAHLO4 I RADUPA S RAERR="Duplicate Addendum" Q
79 ; check resident and staff
80 N X1,X2,X3 S X2=0,X3=""
81 I '$G(RATELE),+$G(^TMP("RARPT-REC",$J,RASUB,"RARESIDENT"))!(+$G(^("RASTAFF"))) D Q:$G(RAERR)]""
82 . S X1=+$G(^TMP("RARPT-REC",$J,RASUB,"RARESIDENT"))
83 . I X1 D
84 .. I '$D(^VA(200,"ARC","R",X1)),'$D(^VA(200,"ARC","S",X1)) S X2=1
85 .. I $P($G(^VA(200,X1,"RA")),"^",3),$P(^("RA"),"^",3)'>$$DT^XLFDT S X2=X2+2
86 .. I X2=1 S X3=$E($P($G(^VA(200,X1,0)),"^"),1,20)_" is not class'd as Resident or Staff"
87 .. I X2=2 S X3=$P($G(^VA(200,X1,0)),"^")_"'s INACTIVE DATE is past"
88 .. I X2=3 S X3=$P($G(^VA(200,X1,0)),"^")_" is not class'd as resident and past INACTIVE DATE"
89 .. I X3]"" S RAERR=X3
90 . S X2=0,X3="" S X1=+$G(^TMP("RARPT-REC",$J,RASUB,"RASTAFF"))
91 . I X1 D
92 .. I '$D(^VA(200,"ARC","S",X1)) S X2=1
93 .. I $P($G(^VA(200,X1,"RA")),"^",3),$P(^("RA"),"^",3)'>$$DT^XLFDT S X2=X2+2
94 .. I X2=1 S X3=$E($P($G(^VA(200,X1,0)),"^"),1,20)_" is not class'd as staff"
95 .. I X2=2 S X3=$P($G(^VA(200,X1,0)),"^")_"'s INACTIVE DATE is past"
96 .. I X2=3 S X3=$P($G(^VA(200,X1,0)),"^")_" is not class'd as staff and past INACTIVE DATE"
97 .. I X3]"" S RAERR=$S($G(RAERR)]"":RAERR_", ",1:"")_X3
98 . Q
99 ; raesig is in alphanumeric format, so shouldn't use $g of it here
100 I ($G(RAESIG)]"")!($G(RAVERF)) D:'$G(RATELE) VERCHK^RAHLO3 ; check if provider can verify report
101 ; if verifier fails checks,
102 ; quit only if vendor is non-kurzweil,
103 ; if vendor is kurzweil, continue on by deleting raerr, raverf
104 I $D(RAERR) Q:$G(^TMP("RARPT-REC",$J,RASUB,"VENDOR"))'="KURZWEIL" K RAERR,RAVERF
105 S RAIMGTY=$$IMGTY^RAUTL12("l",RAMLC) I '$L(RAIMGTY) S RAERR="No Imaging Type for Location where exam was performed" Q
106 K RASECDX ;clear secondary dx array because RAHLO2 may not be called
107 ; 09/07/2005 108405 KAM- Removed ('$D(RADENDUM)#2) from next line
108 I $G(RATELE),'$D(RADENDUM),'$D(^TMP("RARPT-REC",$J,RASUB,"RADX")) D ;Patch 84
109 .I RASTAT="R" S:$D(RATELEDR) ^TMP("RARPT-REC",$J,RASUB,"RADX",1)=RATELEDR Q
110 .S:$D(RATELEDF) ^TMP("RARPT-REC",$J,RASUB,"RADX",1)=RATELEDF
111 D:$D(^TMP("RARPT-REC",$J,RASUB,"RADX")) DIAG^RAHLO2 Q:$D(RAERR) ; DX code check took out - &('$D(RADENDUM)#2)
112 ; edit sec Dx codes if they exist for non-addendums
113 ; 09/07/2005 108405 KAM - Removed ('$D(RADENDUM)#2)from next line
114 I $D(RASECDX) D SECDX^RAHLO2 Q:$D(RAERR)
115 S B=0 F A="I","R" D Q:$D(RAERR)
116 . Q:A="R"&('$D(^TMP("RARPT-REC",$J,RASUB,"RATXT"))) ; no rpt text
117 . Q:A="I"&('$D(^TMP("RARPT-REC",$J,RASUB,"RAIMP"))) ; no imp text
118 . S B=$$TEXT^RAHLO3(A)
119 . S:'B RAERR=$$ERR^RAHLO2(A)
120 . Q
121 I $G(RATELE),$G(RARPT) D Q:$D(RAERR) ;PATCH 84
122 .I $D(^RARPT(RARPT,0)) D LOCK^DILF($NA(^RARPT(RARPT))) E S RAERR="Report: "_$P($G(^RARPT(RARPT,0)),"^")_" Locked on VISTA site" Q
123 .L -^RARPT(RARPT)
124 I $G(RATELE),$L($G(RATELEPI)),RATELEPI'?10N S RAERR="Incorrect Teleradiologist's NPI: "_RATELEPI Q
125 D RPTSTAT^RAHLO3 ; determine the status of the report
126 D FILE^RAHLO1:'$D(RAERR)
127 Q
Note: See TracBrowser for help on using the repository browser.