source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBAALU.m@ 1073

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

initial load of WorldVistAEHR
File size: 6.2 KB
Line 
1FBAALU ;AISC/GRR,WCIOFO/SAB-CPT CODE & MODIFIER LOOKUP ;7/15/1999
2 ;;3.5;FEE BASIS;**4,77,85**;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5CPTM(FBDOS,FBDFN,FBCPT,FBMODL) ; Ask CPT Code and optional CPT Modifiers
6 ; input
7 ; FBDOS - (optional) date of service, fileman format
8 ; FBDFN - (optional) patient DFN, pointer to file #2 and file #161
9 ; FBCPT - (optional) default CPT value (internal)
10 ; FBMODL- (optional) list of default modifiers (internal)
11 ; delimited by commas
12 ; only used when FBCPT accepted by user
13 ; output
14 ; FBAACP - CPT code (internal)
15 ; OR null if not selected
16 ; OR @ if default value (FBCPT) was supplied and user
17 ; entered an @ at the service provided prompt.
18 ; FBX - CPT code (external) OR null if not selected
19 ; FBMODA( - (optional) CPT modifier array
20 ; FBMODA(#) = CPT modifier (internal)
21 ; where # is a integer greater than 0
22 ; FBGOT - flag (0 or 1) =1 if CPT code was specified and confirmed
23 ;
24INIT ; initialize optional input variables and FBGOT
25 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
26 N FBCATX,FBCPTX,FBEDIT,FBI,FBLAST,FBMOD,FBMODLE,FBMODX,FBTX
27 S:$G(FBDOS)="" FBDOS=DT
28 S FBDFN=$G(FBDFN)
29 S FBGOT=0
30 ;
31ASKCPT ; prompt for CPT code
32 S DIR(0)="PO^81:EMZ"
33 S DIR("A")=$S($G(FBCPT)>0:"",1:"Select ")_"Service Provided"
34 I $G(FBCPT)>0 S DIR("B")=$$CPT^FBAAUTL4(FBCPT)
35 S DIR("?",1)="The Current Procedural Terminology Code (CPT Code) as"
36 S DIR("?",2)="specified on the vendors invoice identifying the service"
37 S DIR("?")="the vendor provided to the veteran."
38 S ICPTVDT=$G(FBDOS) D ^DIR K DIR,ICPTVDT I $D(DTOUT)!$D(DUOUT) G EXIT
39 I $G(FBCPT)]"",X="@" D G:FBGOT EXIT G ASKCPT
40 . S DIR(0)="Y"
41 . S DIR("A")="SURE YOU WANT TO DELETE THE ENTIRE SERVICE PROVIDED"
42 . D ^DIR K DIR I Y S FBGOT=1,FBAACP="@",FBX="" K FBMODA
43 I Y>0 S FBAACP=+Y,FBX=$P(Y,U,2)
44 E G EXIT
45 ; *** PASS 3RD PARAMETER TO INCLUDE VA NATIONAL/LOCAL CODES
46 S FBCPTX=$$CPT^ICPTCOD(FBAACP,FBDOS,1)
47 I '$P(FBCPTX,U,7) D G ASKCPT
48 . W $C(7),!," CPT code inactive on date of service ("
49 . W $$FMTE^XLFDT(FBDOS),")"
50 ;
51 K FBMODA
52 I $G(FBCPT)>0,FBCPT=FBAACP,$G(FBMODL)]"" D
53 . N FBI,FBMOD
54 . F FBI=1:1 S FBMOD=$P(FBMODL,",",FBI) Q:FBMOD="" S FBMODA(FBI)=FBMOD
55 ;
56ASKMOD ; multiply prompt for CPT modifiers
57 ; determine highest number used in list
58 S FBLAST=$O(FBMODA(" "),-1)
59 ; prompt for CPT modifier
60 S DIR(0)="PO^81.3:EMZ"
61 S DIR("A")="Select CPT MODIFIER"
62 S DIR("?")="^D MODHLP^FBAALU"
63 ; *** COMMENT FOLLOWING LINE IF ACCURACY OF API IS NOT FIXED
64 ;S DIR("S")="I $$MODP^ICPTMOD(FBAACP,Y,""I"",FBDOS,1)>0"
65 S FBMODLE=$$MODL^FBAAUTL4("FBMODA","E")
66 W !!,"Current list of modifiers: ",$S(FBMODLE]"":FBMODLE,1:"none")
67 S ICPTVDT=$G(FBDOS) D ^DIR K DIR,ICPTVDT I $D(DTOUT)!$D(DUOUT) G EXIT
68 ; if value was entered then process it and ask another
69 I +Y>0 D G ASKMOD
70 . S FBMOD=+Y
71 . ; if specified CPT modifier already in list set FBEDIT = it's number
72 . S (FBI,FBEDIT)=0 F S FBI=$O(FBMODA(FBI)) Q:'FBI D Q:FBEDIT
73 . . I FBMODA(FBI)=FBMOD S FBEDIT=FBI
74 . ; if in list then edit the existing modifier
75 . I FBEDIT D Q:$D(DIRUT)
76 . . S DIR(0)="PO^81.3:EMZ"
77 . . S DIR("A")=" CPT MODIFIER"
78 . . S DIR("B")=$$MOD^FBAAUTL4(FBMODA(FBEDIT))
79 . . ; *** COMMENT FOLLOWING LINE IF ACCURACY OF API IS NOT FIXED
80 . . ;S DIR("S")="I $$MODP^ICPTMOD(FBAACP,Y,""I"",FBDOS,1)>0"
81 . . S ICPTVDT=$G(FBDOS) D ^DIR K DIR,ICPTVDT
82 . . I X="@" K FBMODA(FBEDIT) W " (deleted)" ; "@" removes from list
83 . . I +Y>0 S FBMOD=+Y
84 . ; validate entered modifier
85 . S FBMODX=$$MOD^ICPTMOD(FBMOD,"I",FBDOS,1)
86 . I '$P(FBMODX,U,7) D Q
87 . . W $C(7),!," CPT Modifier inactive on date of service ("
88 . . W $$FMTE^XLFDT(FBDOS),")"
89 . ; ensure new value of edited modifier is not already on list
90 . I FBEDIT D Q:FBMOD=""
91 . . S FBI=0 F S FBI=$O(FBMODA(FBI)) Q:'FBI D Q:FBMOD=""
92 . . . I FBMODA(FBI)=FBMOD,FBI'=FBEDIT S FBMOD="" W !,$C(7)," Change was not accepted because the new value is already on the list."
93 . ; update list
94 . I FBEDIT S FBMODA(FBEDIT)=FBMOD ; updated existing modifier
95 . E S FBLAST=FBLAST+1,FBMODA(FBLAST)=FBMOD ; added new modifier
96 ;
97DIS ; display entered data
98 ; if default CPT code exists and default code and modifiers were not
99 ; changed then skip display and confirm steps.
100 I $G(FBCPT)>0,FBCPT=FBAACP,$G(FBMODL)=$$MODL^FBAAUTL4("FBMODA","I") S FBGOT=1 G EXIT
101 S FBCATX=$$CAT^ICPTAPIU($P(FBCPTX,U,4))
102 W !!,"Major Category: " W:$P(FBCATX,U)'=-1 $P(FBCATX,U,4)
103 W !,?2,"Sub-Category: " W:$P(FBCATX,U)'=-1 $P(FBCATX,U)
104 W !,?6,"Procedure: ",$P(FBCPTX,U,2)," ",$P(FBCPTX,U,3)
105 I $O(FBMODA(0)) D
106 . W !,?6,"Modifiers: "
107 . S FBI=0 F S FBI=$O(FBMODA(FBI)) Q:'FBI D
108 . . S FBMODX=$$MOD^ICPTMOD(FBMODA(FBI),"I",FBDOS,1)
109 . . W ?22,"-",$P(FBMODX,U,2)," ",$P(FBMODX,U,3),!
110 E W !
111 W !,?20,"Detail Description ",!,?20,"=================="
112 K FBTX
113 S X=$$CPTD^ICPTCOD(FBAACP,"FBTX",$G(FBDFN),$G(FBDOS))
114 S FBI=0 F S FBI=$O(FBTX(FBI)) Q:'FBI W !,FBTX(FBI)
115 ;
116CONF ; confirm entered data
117 S DIR(0)="Y",DIR("A")="Is this correct",DIR("B")="YES"
118 D ^DIR K DIR I $D(DIRUT) G EXIT
119 I 'Y W ! G ASKCPT
120 S FBGOT=1
121 ;
122EXIT ; exit point
123 I 'FBGOT S FBAACP="",FBX="" K FBMODA
124 Q
125 ;
126MODHLP ; CPT MODIFIER prompt help text
127 ; input
128 ; FBMODA( - (optional) array of modifiers
129 ; FBMODA(#)=CPT MODIFIER (internal)
130 ;
131 N DIR,DIROUT,DIRUT,DTOUT,DUOUT
132 N FBI,FBL,FBMODX,FBQUIT,FBTX
133 ;
134 ; compile help text for modifier prompt including a list of
135 ; previously entered modifiers.
136 S FBTX(1)="Modifiers are used to better describe the service (CPT)"
137 S FBTX(2)="rendered. Modifier(s) will be combined with the CPT code"
138 S FBTX(3)="for Fee Schedule calculations and to check for duplicate"
139 S FBTX(4)="payment entry."
140 I $O(FBMODA(0)) D
141 . N FBI,FBL,FBMODX
142 . S FBTX(5)=" "
143 . S FBL=5
144 . S FBI=0 F S FBI=$O(FBMODA(FBI)) Q:'FBI D
145 . . S FBMODX=$$MOD^ICPTMOD(FBMODA(FBI),"I",$G(FBDOS),1)
146 . . S FBL=FBL+1,FBTX(FBL)=" "_$P(FBMODX,U,2)_" "_$P(FBMODX,U,3)
147 ;
148 ; display the help text
149 S FBL=0 F S FBL=$O(FBTX(FBL)) Q:'FBL D Q:$D(DIRUT)
150 . ; pause between screens of data (22 lines)
151 . I $E(IOST,1,2)="C-",'(FBL#22) S DIR(0)="E" D ^DIR K DIR Q:$D(DIRUT)
152 . ; write a line of text
153 . W !,FBTX(FBL)
154 ;
155 Q
156 ;
157 ;FBAALU
Note: See TracBrowser for help on using the repository browser.