source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RACPTCSV.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 5.8 KB
Line 
1RACPTCSV ;HISC/SWM - CPT Code Set Version ;2/23/04 09:03
2 ;;5.0;Radiology/Nuclear Medicine;**38,46**;Mar 16, 1998
3 Q
4ACTC() ; find out if CPT CODE is active
5 ; called from file 70.03 field 2's DIC("S")
6 ; Y = ien file 71
7 ; DA(2) = RADFN
8 ; DA(1) = RADTI
9 N RAACTIV,RA710,RACPT,RACPTNAM,RADT0,RAMSG,RADATE,RADATV
10 N RATXT,RAI,RAX ; RATXT is local array of error text
11 S RAACTIV=1 ; =1 no error, or CPT CODE is active
12 S RAI=0 ; counter
13 S RA710=^RAMIS(71,+Y,0)
14 S RACPT=$P(RA710,U,9)
15 I RACPT="",($P(RA710,U,6)="D")!($P(RA710,U,6)="S") D S RAACTIV=0
16 . S RAI=RAI+1
17 . S RATXT(RAI)="** A Detailed or Series procedure is missing a CPT CODE.**"
18 . Q
19 S RADT0=^RADPT(DA(2),"DT",DA(1),0),RADATE=$P(RADT0,U)
20 I $P(RA710,U,6)="P" D S RAACTIV=0
21 . S RAI=RAI+1
22 . S RATXT(RAI)="** Procedure is a parent type. **"
23 . Q
24 I $D(^RAMIS(71,+Y,"I"))#2,^("I")'="",^("I")'>DT D S RAACTIV=0
25 . S RADATV=$$FMTE^XLFDT($P(^RAMIS(71,+Y,"I"),U),2) ; convert inact.dt
26 . S RAI=RAI+1
27 . S RATXT(RAI)="** Procedure is inactive since "_RADATV_". **"
28 . Q
29 I $P(RA710,U,12)'=$P(^RADPT(DA(2),"DT",DA(1),0),U,2) D S RAACTIV=0
30 . S RAI=RAI+1
31 . S RATXT(RAI)="** Procedure's Imaging Type differs from Exam's Imaging Type. **"
32 . Q
33 S RADATV=$$FMTE^XLFDT(RADATE,2) ; convert Exam Date
34 I RACPT,'$$ACTCODE^RACPTMSC(RACPT,RADATE) D S RAACTIV=0
35 . S RACPTNAM=$P($$NAMCODE^RACPTMSC(RACPT,RADATE),U)
36 . S RAI=RAI+1
37 . S RATXT(RAI)="** Procedure's CPT "_RACPTNAM_" is invalid for Exam Date "_RADATV_". **"
38 .; if registering exam, and order is parent proc, display help message
39 . I $D(RAOPT("REG")),$P($G(^RAMIS(71,+$P($G(^RAO(75.1,+$G(RAORDS(1)),0)),U,2),0)),U,6)="P" D
40 .. S RAI=RAI+1
41 .. S RATXT(RAI)="** Enter ""^"" to skip this descendent"
42 .. S RAI=RAI+1
43 .. S RATXT(RAI)=" or enter a procedure with an active CPT code. **"
44 .. Q
45 . Q
46 I RAACTIV Q RAACTIV ; no errors flagged
47 I '$D(RATXT) Q RAACTIV ; quit warning if no error text in local array
48 ; X is what user typed, or is proc at // if user pressed return key
49 I $E(RA710,1,$L(X))'=X Q RAACTIV ; quit warning if X'=prcnam begin chars
50 I $P(^RAMIS(71,Y,0),U)'=X Q RAACTIV ; quit warning if lookup prcnam '= X
51 ; if registering, quit warning if both met:
52 ; if user input matches order's procedure (frm descnd if parnt ordr)
53 ; if lookup IEN isn't same as order's proc's ien
54 ; note: RAPRC won't exist if procs added aftr descnts entered
55 I $D(RAOPT("REG")),X=$G(RAPRC),Y'=$G(RAPROCI) Q RAACTIV
56 S RAMSG=$P(RA710,U)
57 D EN^DDIOL(RAMSG,,"!")
58 S RAI=0
59 F S RAI=$O(RATXT(RAI)) Q:'RAI S RAMSG=RATXT(RAI) D EN^DDIOL(RAMSG,,"!?4")
60 S RAMSG=""
61 D EN^DDIOL(RAMSG,,"!") ; put blank line after listing
62 Q RAACTIV
63FUTC() ; called from input templates [RA EXAM EDIT], [RA STATUS CHANGE]
64 ; IF exam date is future to first Log Date:
65 ; check CPT CODE when/after that date arrives
66 ; and last Log Date isn't later than Exam Date
67 ; assumes existing RADFN,RADTI,RACNI,RADTE
68 ; RETURNS 0=inact.CPT Code, 1=active CPT Code
69 N RADTEX,RARET,RALOG1,RALOGL,RA71,RACPTNAM,RAMSG,RAX
70 S RARET=1 ; default return to 1 (active)
71 S RAX=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0) G:RAX="" FUTCQ
72 S RADTEX=RADTE\1 ; date portion of RADTE
73 S RALOG1=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"L",0)) G:'RALOG1 FUTCQ
74 S RALOG1=+^RADPT(RADFN,"DT",RADTI,"P",RACNI,"L",RALOG1,0)\1 G:'RALOG1 FUTCQ ;dt portion 1st log date
75 G:RALOG1'<RADTEX FUTCQ ;1st Log Date same/greater than Exam Date
76 G:DT<RADTEX FUTCQ ; future Exam Date hasn't arrived yet
77 S RALOGL=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"L",""),-1) G:'RALOGL FUTCQ
78 S RALOGL=+^RADPT(RADFN,"DT",RADTI,"P",RACNI,"L",RALOGL,0)\1 ;dt portion last log date
79 G:RALOGL'<RADTEX FUTCQ ;latest Log Date = OR > Exam Date
80 ; now check CPT CODE from case record
81 S RA71=$G(^RAMIS(71,+$P(RAX,U,2),0))
82 S RARET=$$ACTCODE^RACPTMSC(+$P(RA71,"^",9),RADTE)
83 I 'RARET D
84 . S RACPTNAM=$P($$NAMCODE^RACPTMSC(+$P(RA71,"^",9),RADTE),U)
85 . S RAMSG="*** Exam was registered with a future date, and since ***"
86 . D EN^DDIOL(RAMSG,,"!?4")
87 . S RAMSG="*** registration, its CPT Code "_RACPTNAM_" has been inactivated. ***"
88 . D EN^DDIOL(RAMSG,,"!?4")
89 . S RAMSG="You must choose a procedure that has an active CPT Code."
90 . D EN^DDIOL(RAMSG,,"!!?4")
91 . D EN^DDIOL(" ",,"!?4")
92 . Q
93FUTCQ ;
94 Q RARET
95FUTCMOD() ; called from input templates [RA EXAM EDIT], [RA STATUS CHANGE]
96 ; IF exam date is future to first Log Date:
97 ; check CPT Modifier when/after that date arrives
98 ; and last Log Date isn't later than Exam Date
99 ; assumes existing RADFN,RADTI,RACNI,RADTE
100 ; RETURNS 0=at least one CPT Mod is inactive, 1=all CPT Mods active
101 N RADTEX,RARET,RALOG1,RALOGL,RA813,RAMSG,RA0,RA1,RAX,RAMODSTR
102 S RARET=1 ;default return value to 1
103 G:'$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",0)) FUTCMODQ ; no cpt mod entered
104 S RADTEX=RADTE\1 ; date portion of RADTE
105 S RALOG1=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"L",0)) G:'RALOG1 FUTCMODQ
106 S RALOG1=+^RADPT(RADFN,"DT",RADTI,"P",RACNI,"L",RALOG1,0)\1 G:'RALOG1 FUTCMODQ ;dt portion 1st log date
107 G:RALOG1'<RADTEX FUTCMODQ ; 1st Log date same/greater than Exam Date
108 G:DT<RADTEX FUTCMODQ ; future Exam Date hasn't arrived yet
109 S RALOGL=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"L",""),-1) G:'RALOGL FUTCMODQ
110 S RALOGL=+^RADPT(RADFN,"DT",RADTI,"P",RACNI,"L",RALOGL,0)\1 G:'RALOGL FUTCMODQ ;dt portion last log date
111 G:RALOGL'<RADTEX FUTCMODQ ;latest Log Date = OR > Exam Date
112 ; now check all CPT Mods from case record
113 S RA1=0 F S RA1=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",RA1)) Q:'RA1 D
114 . S RAX=+^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",RA1,0)
115 . S RA0=$$ACTMOD^RACPTMSC(RAX,RADTE)
116 . I 'RA0 S RARET=0 D
117 .. S RAMSG="Exam was registered with a future date, and since registration,"
118 .. D EN^DDIOL(RAMSG,,"!?4")
119 .. S RAMSG=$P(RAMODSTR,"^",2)_" "_$P(RAMODSTR,"^",3)_" has been inactivated."
120 .. D EN^DDIOL(RAMSG,,"!?4")
121 .. Q
122 . Q
123 I 'RARET D EN^DDIOL("You must delete the inactive CPT Modifier(s) before you can continue.",,"!?4")
124FUTCMODQ ;
125 Q RARET
126 ;
Note: See TracBrowser for help on using the repository browser.