source: FOIAVistA/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXCECPT.m@ 677

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

initial load of FOIAVistA 6/30/08 version
File size: 9.5 KB
Line 
1PXCECPT ;ISL/dee,ISA/Zoltan,esw - Used to edit and display V CPT ;6/22/04 3:27pm
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**14,27,73,89,112,121,136,124,170,164,182**;Aug 12, 1996;Build 3
3 ;; ;
4 Q
5 ;
6 ;+Structure of Line with the line label "FORMAT"
7 ;+;;Long name~File Number~Node Subscripts~Allow Duplicate entries (1=yes, 0=no)~File global name
8 ;+ 1 2 3 4 5
9 ;+
10 ;+Structure of Following lines:
11 ;+;;Node~Piece~,Field Number~Edit Label~Display Label~Display Routine~Edit Routine~Help Text for DIR("?")~Set of PXCEKEYS that can Edit~D if Detail Display Only~
12 ;+ 1 ~ 2 ~ 3 ~ 4 ~ 5 ~ 6 ~ 7 ~ 8 ~ 9 ~ 10
13 ;+The Display & Edit routines are for special cases.
14 ;+ (The .01 fields cannot have a special edit.)
15 ;
16FORMAT ;;CPT~9000010.18~0,1,12,802,811,812~1~^AUPNVCPT
17 ;;0~1~.01~CPT Code: ~CPT Code: ~$$DISPLY01^PXCECPT~ECPTCODE^PXCECPT~^D HELP^PXCEHELP~~B
18 ;;0~19~.19~Department Code: ~Department Code: ~~DEPART^PXCECPT1~~~D
19 ;;0~17~.17~Order Reference: ~Order Reference: ~~SKIP^PXCECPT~~~D
20 ;;1~0~1~CPT Modifier: ~CPT Modifier: ~$$DISPMOD^PXCECPT~ECPTMOD^PXCECPT~Select a Modifier that is valid for the CPT code.~~B
21 ;;0~4~.04~Provider Narrative: ~Provider Narrative: ~$$DNARRAT^PXCECPT~ENARRAT^PXCEPOV1(1,1,1,81,2)~~~B
22 ;;0~16~.16~Quantity: ~Quantity: ~~EQUAN^PXCECPT~~~D
23 ;;0~7~.07~Principal Procedure: ~Principal Procedure: ~~~~~D
24 ;;12~2~1202~Ordering Provider: ~Ordering Provider: ~~EPROV12^PXCEPRV~~~D
25 ;;12~4~1204~Encounter Provider: ~Encounter Provider: ~~EPROV12^PXCEPRV~~~D
26 ;;802~1~80201~Provider Narrative Category: ~Provider Narrative Category: ~$$DNARRAT^PXCECPT~ENARRAT^PXCEPOV1(0,2,0,81,3)~~C~D
27 ;;811~1~81101~Comments: ~Comments: ~~~~~D
28 ;;0~5~.05~Primary Diagnosis: ~Primary Diagnosis: ~$$DISPLY01^PXCEPOV~EPOV^PXCECPT~~~
29 ;;0~9~.09~1st Secondary Diagnosis: ~1st Secondary Diagnosis: ~$$DISPLY01^PXCEPOV~EPOV^PXCECPT~~~
30 ;;0~10~.1~2nd Secondary Diagnosis: ~2nd Secondary Diagnosis: ~$$DISPLY01^PXCEPOV~EPOV^PXCECPT~~~
31 ;;0~11~.11~3rd Secondary Diagnosis: ~3rd Secondary Diagnosis: ~$$DISPLY01^PXCEPOV~EPOV^PXCECPT~~~
32 ;;0~12~.12~4th Secondary Diagnosis: ~4th Secondary Diagnosis: ~$$DISPLY01^PXCEPOV~EPOV^PXCECPT~~~
33 ;;0~13~.13~5th Secondary Diagnosis: ~5th Secondary Diagnosis: ~$$DISPLY01^PXCEPOV~EPOV^PXCECPT~~~
34 ;;0~14~.14~6th Secondary Diagnosis: ~6th Secondary Diagnosis: ~$$DISPLY01^PXCEPOV~EPOV^PXCECPT~~~
35 ;;0~15~.15~7th Secondary Diagnosis: ~7th Secondary Diagnosis: ~$$DISPLY01^PXCEPOV~EPOV^PXCECPT~~~
36 ;;
37 ;
38 ;The interface for AICS to get list on form for help.
39INTRFACE ;;DG SELECT CPT PROCEDURE CODES
40 ;+
41 ;+********************************
42 ;+Special cases for display.
43 ;
44DISPMOD(PXCECPT) ;
45 ;+Display the modifiers associated with this V CPT entry.
46 ;+PXCECPT = IEN in V CPT file.
47 N MODS,SIEN,MODIEN,SCRATCH,MODSTR,MODNAME,OUTSTR
48 I $G(PXCECPT)="" S PXCECPT=IEN
49 S OUTSTR=""
50 I PXCECPT="" Q OUTSTR
51 S SIEN=0
52 F MODS=1:1 S SIEN=$O(^AUPNVCPT(PXCECPT,1,SIEN)) Q:'SIEN D
53 . S MODIEN=$P($G(^AUPNVCPT(PXCECPT,1,SIEN,0)),"^")
54 . S $P(OUTSTR,U,MODS)=$$MODTEXT(MODIEN)
55 Q OUTSTR
56DNARRAT(PNAR) ;+Display Provider Narrative for procedure in V CPT file.
57 I PNAR="" Q ""
58 N PXCEPNAR
59 S PXCEPNAR=$P(^AUTNPOV(PNAR,0),"^")
60 I $G(VIEW)="B",$D(ENTRY)>0 D
61 . ;N DIC,DR,DA,DIQ,PXCEDIQ1
62 . ;S DIC=81
63 . ;S DR="2"
64 . ;S DA=$P(ENTRY(0),"^",1)
65 . ;S DIQ="PXCEDIQ1("
66 . ;S DIQ(0)="E"
67 . ;D EN^DIQ1
68 . ;S:PXCEDIQ1(81,DA,2,"E")=PXCEPNAR PXCEPNAR=""
69 . N CPTSTR
70 . S CPTSTR=$$CPT^ICPTCOD($P(ENTRY(0),U),$P(^AUPNVSIT(PXCEVIEN,0),U))
71 . S:$P(CPTSTR,U,3)=PXCEPNAR PXCEPNAR=""
72 Q PXCEPNAR
73 ;+
74 ;+********************************
75 ;+Special cases for edit.
76 ;+
77ECPTCODE ;+Code to edit CPT Code in V CPT file.
78 K DIRUT
79 N DIC,DA,PXCPTDT,PXDFLT
80 S PXCPTDT=+^TMP("PXK",$J,"VST",1,0,"AFTER")
81 S (X,PXDFLT)=""
82 I $P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))'="" D
83 . N DIERR,PXCEDILF,PXCEINT,PXCEEXT
84 . S PXCEINT=$P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))
85 . S PXCEEXT=$$EXTERNAL^DILFD(PXCEFILE,$P(PXCETEXT,"~",3),"",PXCEINT,"PXCEDILF")
86 . S PXDFLT=$S('$D(DIERR):PXCEEXT,1:PXCEINT)
87 S Y=$$GETCODE^PXCPTAPI(PXDFLT,PXCPTDT)
88 I Y="@" S X="@" Q
89 I Y<0 S DIRUT=1 Q
90 S PXCEMOD=$P(Y,"-",2)
91 S Y=$P(Y,"-"),X=+Y
92 I PXCEDIRB="" Q
93 I $P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))=X Q
94 Q:$$CHGCPT()
95 G ECPTCODE
96 ;
97ECPTMOD ;+Prompt for CPT Modifier in V CPT file.
98 ;
99 ;--If there are no modifiers for CPT code do not prompt
100 Q:PXMDCNT'>0
101 N DTOUT,DUOUT,DIROUT,DIR,PXSUB,PXSEQ,PXSTR,PXARR
102 N DA,DIC,PXLINE,SUBIEN,PXFILE,PXMOD,PXI
103 S PXSUB=1,PXSTR=""
104 S DA=^TMP("PXK",$J,PXCECATS,1,"IEN")
105 S DR=1
106 S DIE="^AUPNVCPT("
107 S DIC(0)="AELMQ"
108 L +@(DIE_"DA)"):10
109 I $G(PXCEMOD)]"" D
110 . I $L(PXCEMOD,",")=1 S DR="1//"_PXCEMOD Q
111 . S PXMOD=""
112 . F PXI=1:1 S PXMOD=$P(PXCEMOD,",",PXI) Q:PXMOD="" D
113 .. K PXERR
114 .. D VAL^DIE(9000010.181,DA,.01,"",PXMOD,.PXERR)
115 .. Q:PXERR="^"
116 .. S DR="1///^S X=PXMOD"
117 .. D ^DIE
118 . S DR=1
119 D ^DIE
120 L -@(DIE_"DA)")
121 ; SET NEWLY FILED CPT MODIFIERS INTO LOCAL ARRAY
122 K PXCEAFTR(1)
123 D GETS^DIQ(9000010.18,^TMP("PXK",$J,PXCECATS,1,"IEN"),"1*","I","PXARR")
124 S PXFILE=9000010.181
125 S PXSUB=""
126 F S PXSUB=$O(PXARR(PXFILE,PXSUB)) Q:PXSUB="" D
127 . S PXCEAFTR(1,$P(PXSUB,","))=PXARR(PXFILE,PXSUB,.01,"I")
128 I $D(DTOUT)!$D(Y) S (PXCEEND,PXCEQUIT)=1 Q
129 Q
130 ;
131EQUAN ;+Code to edit Quantity in V CPT file.
132 I $P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))'="" D
133 . N DIERR,PXCEDILF,PXCEINT,PXCEEXT
134 . S PXCEINT=$P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))
135 . S PXCEEXT=$$EXTERNAL^DILFD(PXCEFILE,$P(PXCETEXT,"~",3),"",PXCEINT,"PXCEDILF")
136 . S DIR("B")=$S('$D(DIERR):PXCEEXT,1:PXCEINT)
137 E S DIR("B")=1
138 S DIR(0)=PXCEFILE_","_$P(PXCETEXT,"~",3)_"A"
139 S DIR("A")=$P(PXCETEXT,"~",4)
140 S:$P(PXCETEXT,"~",8)]"" DIR("?")=$P(PXCETEXT,"~",8)
141 D ^DIR
142 K DIR,DA
143 I $D(DTOUT)!$D(DUOUT) S (PXCEEND,PXCEQUIT)=1 Q
144 I +Y<1 W !,$C(7),"Quantity is required.",! G EQUAN
145 N PXTMPCPT S PXTMPCPT=$P(PXCEAFTR($P(PXCETEXT,"~")),"^")
146 I +Y>1,$$GET1^DIQ(357.69,$G(PXCEIN01),.01)>0,$$GET1^DIQ(357.69,$G(PXCEIN01),.06,"I")'="Y" D
147 .W !,"E&M code, quantity changed to 1."
148 .S $P(Y,"^")=1
149 S:$P(Y,"^")="" Y=1
150 S $P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))=$P(Y,"^")
151 Q
152EPOV ;Edit the Associated DX
153 I $P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))'="" D
154 .N DIERR,PXCEDILF,PXCEINT,PXCEEXT
155 .S PXCEINT=$P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))
156 .S PXCEEXT=$$EXTERNAL^DILFD(PXCEFILE,$P(PXCETEXT,"~",3),"",PXCEINT,"PXCEDILF")
157 .S DIR("B")=$S('$D(DIERR):PXCEEXT,1:PXCEINT)
158 S DIR(0)=PXCEFILE_","_$P(PXCETEXT,"~",3)_"A"
159 S DIR("A")=$P(PXCETEXT,"~",4)
160 S:$P(PXCETEXT,"~",8)]"" DIR("?")=$P(PXCETEXT,"~",8)
161 D ^DIR
162 K DIR,DA
163 I X="@" S Y="@" S $P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))=$P(Y,"^") Q
164 I $D(DTOUT)!$D(DUOUT) S PXCEEND=1,PXCEQUIT=1 Q
165 ;I '+Y S PXCEEND=1 Q ;S:$P(PXCETEXT,"~",3)=".05" PXCEQUIT=1 Q
166 I +Y'>0 S PXCEEND=1 Q ;PX*1.0*182 for "^" or null entry from list
167 ;See if this diagnosis is in the PXCEAFTR(0)
168 I $P(PXCETEXT,"~",2)'=5,(+Y=$P($G(PXCEAFTR(0)),"^",5)) S PXCEEND=1
169 I $P(PXCETEXT,"~",2)'=9,(+Y=$P($G(PXCEAFTR(0)),"^",9)) S PXCEEND=1
170 I $P(PXCETEXT,"~",2)'=10,(+Y=$P($G(PXCEAFTR(0)),"^",10)) S PXCEEND=1
171 I $P(PXCETEXT,"~",2)'=11,(+Y=$P($G(PXCEAFTR(0)),"^",11)) S PXCEEND=1
172 I $P(PXCETEXT,"~",2)'=12,(+Y=$P($G(PXCEAFTR(0)),"^",12)) S PXCEEND=1
173 I $P(PXCETEXT,"~",2)'=13,(+Y=$P($G(PXCEAFTR(0)),"^",13)) S PXCEEND=1
174 I $P(PXCETEXT,"~",2)'=14,(+Y=$P($G(PXCEAFTR(0)),"^",14)) S PXCEEND=1
175 I $P(PXCETEXT,"~",2)'=15,(+Y=$P($G(PXCEAFTR(0)),"^",15)) S PXCEEND=1
176 I PXCEEND=1 W !,$C(7),"Duplicate Diagnosis on this CPT code is not allowed." D WAIT^PXCEHELP Q
177 S $P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))=$P(Y,"^")
178 D:+Y>0 DIAGNOS^PXCEVFI4(+Y)
179 Q
180 ;+
181 ;+********************************
182 ;+Special Reusable Functionality
183DISPLY01(PXCECPT) ;
184 ;Display text for the .01 field which is a pointer to ^ICPT.
185 ;Also called with the Evaluation and Management Code from the visit
186 ; in the parameter.
187 ;(Must have is called by ASK^PXCEVFI2 and DEL^PXCEVFI2.)
188 ;N DIC,DR,DA,DIQ,PXCEFNUM,PXCEDIQ1
189 ;S (DIC,PXCEFNUM)=81
190 ;S DR=".01;2"
191 ;S DA=+$P(PXCECPT,"^",1)
192 ;S DIQ="PXCEDIQ1("
193 ;S DIQ(0)="E"
194 ;D EN^DIQ1
195 ;Q PXCEDIQ1(PXCEFNUM,DA,.01,"E")_" "_PXCEDIQ1(PXCEFNUM,DA,2,"E")
196 N CPTSTR
197 S CPTSTR=$$CPT^ICPTCOD($P(PXCECPT,U),$P(^AUPNVSIT(PXCEVIEN,0),U))
198 Q $P(CPTSTR,U,2)_" "_$P(CPTSTR,U,3)
199EDMOD(MODS,CPT) ;+Edit the Modifiers for a CPT code entry.
200 N MNUM S MNUM=0 ; Modifier number.
201 N MIEN,MTEXT
202 Q
203MODNAME(MODIEN) ;+Return #.02 NAME for this CPT MODIFIER (#81.3)
204 Q
205MODTEXT(MODIEN) ;+Return string of text describing modifier.
206 ;+MODIEN = IEN in CPT MODIFIER file (#81.3).
207 ;+Returns: MODIFIER (#.01) followed by NAME(#.02).
208 N MOD,DESC,TEXT,RVAL
209 S RVAL=$$MOD^ICPTMOD(MODIEN,"I",$P(^AUPNVSIT(PXCEVIEN,0),U))
210 S MOD=$P(RVAL,"^",2)
211 S DESC=$P(RVAL,"^",3)
212 S TEXT=MOD_" "_DESC
213 Q TEXT
214CHGCPT() ;Verify CPT code should be modified
215 ;If response is yes remove modifiers on file for CPT code
216 N DIR,DA,X,Y,PXIEN
217 W !!,$C(7),"WARNING! THIS WILL ALSO DELETE ANY MODIFIERS ASSOCIATED WITH CPT CODE "_PXCEDIRB
218 S DIR(0)="Y"
219 S DIR("A")="SURE YOU WANT TO CHANGE THE CPT CODE?"
220 S DIR("B")="YES"
221 D ^DIR
222 ;Delete CPT Modifiers from V CPT file for current IEN
223 I 'Y Q +Y
224 S DA(1)=PXCEFIEN
225 S DIK="^AUPNVCPT("_DA(1)_","_1_","
226 S PXIEN=""
227 F S PXIEN=$O(PXCEAFTR(1,PXIEN)) Q:PXIEN="" D
228 . S DA=PXIEN
229 . D ^DIK
230 Q 1
231 ;
232NEWCODE ;
233 K DD,DO
234 N DIC,X,Y
235 S DIC="^AUPNVCPT("
236 S DIC(0)=""
237 S DIC("DR")=".02////^S X=$P(PXCEAFTR(0),""^"",2);"
238 S DIC("DR")=DIC("DR")_".03////^S X=$P(PXCEAFTR(0),""^"",3);"
239 S X=PXCEIN01
240 D FILE^DICN
241 S PXCEFIEN=+Y
242 Q
243 ;
244SKIP ;
245 Q
Note: See TracBrowser for help on using the repository browser.