source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RACPTMSC.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: 6.4 KB
Line 
1RACPTMSC ;HISC/SWM - CPT Mod screen, misc. ;5/30/00 11:02
2 ;;5.0;Radiology/Nuclear Medicine;**10,19,38**;Mar 16, 1998
3 Q
4SCRN(Y) ;screen entry of cpt mod
5 ; called from file 70.03's field 135's screen
6 ; Y = ien of file 81.3
7 ; RACPT= CPT ien of this exam's procedure
8 ; RADT = exam date
9 ; RAX = screen's outcome, 0=failed
10 N RACPT,RADT,RAX,RA7002,RA7003,RA1,RA2,RA3
11 S (RA7002,RA7003)=""
12 D SET
13 I RA7002="" Q 0
14 I RA7003="" Q 0
15 S RADT=$P(RA7002,U) I 'RADT Q 0
16 S RACPT=+$P(^RAMIS(71,+$P(RA7003,U,2),0),U,9) I 'RACPT Q 0
17 S RAX=$$MODP^ICPTMOD(RACPT,+Y,"I",RADT) S:RAX<0 RAX=0
18 Q RAX
19SET ; use Rad vars if available
20 I $D(RADFN),$D(RADTI),$D(RACNI) S RA1=RADFN,RA2=RADTI,RA3=RACNI G SET23
21 S RA1=$G(D0),RA2=$G(D1),RA3=$G(D2)
22 Q:((RA1="")!(RA2="")!(RA3=""))
23SET23 S RA7002=$G(^RADPT(RA1,"DT",RA2,0)),RA7003=$G(^RADPT(RA1,"DT",RA2,"P",RA3,0))
24 Q
25DW ; del exam's cpt mods and warn of proc mods
26 ; called from file 70.03's field 2's Mumps xref for kill
27 ; Y = ien of file 81.3
28 N RA7002,RA7003,RA1,RA2,RA3,RAX,RAROOT
29 S (RA7002,RA7003)=""
30 D SET
31 Q:RA7002=""
32 Q:RA7003=""
33 G:'$O(^RADPT(RA1,"DT",RA2,"P",RA3,"CMOD",0)) WARN
34 S RAX=0 ;del all cpt modifiers
35 F S RAX=$O(^RADPT(RA1,"DT",RA2,"P",RA3,"CMOD",RAX)) Q:'RAX D
36 . S RAROOT(70.3135,RAX_","_RA3_","_RA2_","_RA1_",",.01)="@"
37 . D FILE^DIE("K","RAROOT")
38 W !!?5,"All previous CPT Modifier(s) are deleted.",!
39WARN Q:'$O(^RADPT(RA1,"DT",RA2,"P",RA3,"M","B",0))
40 S RAX=0 ;warn of existing proc mods
41 W !!?5,"Current Procedure Modifier(s) :"
42 F S RAX=$O(^RADPT(RA1,"DT",RA2,"P",RA3,"M",RAX)) Q:'RAX W !?10,$P($G(^RAMIS(71.2,+^(RAX,0),0)),U)
43 Q
44ACTCODE(RA1,RA2) ;outputs CPT code active status
45 ; output=1 active, =0 inactive
46 ; RA1 = CPT CODE, internal or external
47 ; RA2 = date to check CPT Code
48 N RA
49 S RA=$$CPT^ICPTCOD(RA1,RA2)
50 I $P(RA,"^",7)=1 Q 1
51 Q 0
52NAMCODE(RA1,RA2) ;outputs flds #.01 and #2 of CPT record
53 ; RA1 = CPT CODE, internal or external
54 ; RA2 = date to check CPT Code
55 N RA
56 S RA=$$CPT^ICPTCOD(RA1,RA2)
57 S:+RA=-1 RA=""
58 S RA=$P(RA,"^",2,3)
59 Q RA
60BASICMOD(RA1,RA2) ; outputs basic modifier info
61 ; RA1 = CPT MODIFIER, internal is used here
62 ; RA2 = date to check CPT Modifier
63 Q $$MOD^ICPTMOD(RA1,"I",RA2)
64ACTMOD(RA1,RA2) ; outputs active status of CPT modifier
65 ; RA1 = CPT MODIFIER, internal is used here
66 ; RA2 = date to check CPT Modifier
67 ; output:
68 ; RA3 = 0 is inactive, >0 is active
69 ; RAMODSTR returned from call to MOD^ICPTMOD
70 N RA3
71 S RAMODSTR=$$MOD^ICPTMOD(RA1,"I",RA2)
72 S RA3=+RAMODSTR
73 S:RA3<0 RA3=0
74 S:'$P(RAMODSTR,U,7) RA3=0
75 Q RA3
76SETDEFS ; set default CPT Modifiers, called by [RA REGISTER]
77 ; 1st choice, defaults from file 71
78 ; 2nd choice, defaults from file 79.1
79 N RAROOT
80 S RAROOT=$S($O(^RAMIS(71,+RAPRI,"DCM",0)):"^RAMIS(71,"_+RAPRI_",""DCM"",",$O(^RA(79.1,+RAMLC,"DCM",0)):"^RA(79.1,"_+RAMLC_",""DCM"",",1:"")
81 Q:RAROOT=""
82 N RA1,RA2,RA3,RAFDA,RAIEN,RAMSG
83 Q:$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",0)) ;<--- ???
84 S RA1=0,RA2=RACNI_","_RADTI_","_RADFN
85LOOP1 K RAFDA,RAIEN,RAMSG ;clear arrays each time
86 S RA1=$O(@(RAROOT_RA1_")")) Q:'RA1
87 S RA3=+@(RAROOT_RA1_",0)")
88 ; convert ien to external so Updater will validate data
89 ; use DT because we're just getting the external value
90 S RA3=$$BASICMOD(RA3,DT)
91 G:+RA3<0 LOOP1 ; skip invalid CPT Modifier
92 G:'$P(RA3,U,7) LOOP1 ; skip inactive CPT Modifier
93 S RAFDA(70.3135,"+2,"_RA2_",",.01)=$P(RA3,U,2)
94 D UPDATE^DIE("E","RAFDA","RAIEN","RAMSG")
95 G:'$D(RAMSG) LOOP1
96 W !!,$C(7),"** Unable to enter default CPT Modifier ",$P(RA3,U,2)," (",$P($P(RA3,U,3)," "),") **",!
97 G LOOP1
98DISCMOD ; display existing CPT Modifiers
99 Q:'$D(RADFN) Q:'$D(RADTI) Q:'$D(RACNI)
100 N RA1,RA2,RA3 S RA1=0
101 W:$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",RA1)) !
102LOOP2 S RA1=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",RA1)) Q:'RA1 S RA2=+^(RA1,0)
103 S RA3=$$BASICMOD(RA2,DT)
104 S:+RA3<0 RA3=""
105 ; need parse with " " to rid trailing blanks
106 W !?6,$P(RA3,"^",2),?9,"(",$P($P(RA3,"^",3)," "),") (",$S($P(RA3,"^",7)=1:"",1:"in"),"active)"
107 G LOOP2
108SDP(Y) ; SCREEN DEFAULT cpt mod for a PROCEDURE
109 ; called from file 71's field 135's screen
110 ; Y = ien of file 81.3
111 ; RACPT= CPT ien of this procedure
112 ; RAX = screen's outcome, 0=failed
113 N RACPT,RAX,RA1,RA2,RA3
114 S RACPT=+$P(^RAMIS(71,+$G(D0),0),U,9) I 'RACPT Q 0
115 S RAX=$$MODP^ICPTMOD(RACPT,+Y,"I",DT) S:RAX<0 RAX=0
116 Q RAX
117SDL(Y) ; SCREEN DEFAULT cpt mod for a LOCATION
118 ; called from file 79.1's field 135's screen
119 ; Y = ien of file 81.3
120 ; RAX = screen's outcome; 0=failed
121 N RAX,RAMODSTR
122 S RAX=$$ACTMOD(Y,DT) S:RAX<0 RAX=0
123 Q RAX
124DISDCM ;display existing Default CPT Modifers for procedure or location
125 ; file 71 used if called from [RA PROCEDURE EDIT]
126 ; file 79.1 used if called from [RA LOCATION PARAMETERS]
127 Q:'($D(DA)#2) Q:'$D(DIE)
128 N RA1,RA2,RA3 S RA1=0
129 D:DIE["79.1" WARNLOC
130 I $O(@(DIE_DA_",""DCM"","_RA1_")")) W !
131 F S RA1=$O(@(DIE_DA_",""DCM"","_RA1_")")) Q:'RA1 S RA2=+^(RA1,0) S RA3=$$BASICMOD(RA2,DT) S:+RA3<0 RA3="" W !?6,$P(RA3,"^",2),?9,"(",$P($P(RA3,"^",3)," "),")"
132 Q
133EHDP ; EXECUTABLE HELP for DEFAULT CPT MODIFIERS (PROC)
134 N RATXT
135 S RATXT(1)=" Choose a CPT Modifier that should be automatically stuffed"
136 S RATXT(2)=" into the exam record with this procedure, during exam"
137 S RATXT(3)=" registration."
138 S RATXT(4)=" "
139 D EN^DDIOL(.RATXT)
140 Q
141EHDL ; EXECUTABLE HELP for DEFAULT CPT MODIFIERS (LOC)
142 D WARNLOC
143 N RATXT
144 S RATXT(1)=" Choose a CPT Modifier that should be automatically stuffed"
145 S RATXT(2)=" into the exam record, when the following 2 conditions"
146 S RATXT(3)=" are both met :"
147 S RATXT(4)=" 1-There is no default CPT Modifier for this exam's procedure."
148 S RATXT(5)=" 2-This location is the current sign-on (or switched-to) location"
149 S RATXT(6)=" at the time of registration."
150 S RATXT(7)=" If your entry is invalid, then during exam registration, this"
151 S RATXT(8)=" Default CPT Modifier will NOT be stuffed, instead, an error message"
152 S RATXT(9)=" with the name of the rejected CPT Modifier would be displayed."
153 S RATXT(10)=" "
154 D EN^DDIOL(.RATXT)
155 Q
156WARNLOC N RATXT
157 S RATXT(1)=" +----------------------------------------------------------------+"
158 S RATXT(2)=" | Your entry cannot be compared with a CPT CODE, so be very sure |"
159 S RATXT(3)=" | that this is the Default CPT Modifier that you want to stuff |"
160 S RATXT(4)=" | into every registered exam from this imaging location. |"
161 S RATXT(5)=" +----------------------------------------------------------------+"
162 D EN^DDIOL(.RATXT)
163 Q
Note: See TracBrowser for help on using the repository browser.