source: FOIAVistA/tag/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAHLO.m@ 636

Last change on this file since 636 was 636, checked in by George Lilly, 14 years ago

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