source: WorldVistAEHR/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSRES.m@ 862

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

initial load of WorldVistAEHR
File size: 8.5 KB
Line 
1BPSRES ;BHAM ISC/BEE - ECME SCREEN RESUBMIT W/EDITS ;19-MAY-06
2 ;;1.0;E CLAIMS MGMT ENGINE;**3,5**;JUN 2004;Build 45
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 Q
6 ;
7 ;ECME Resubmit w/EDITS Protocol (Hidden) - Called by [BPS USER SCREEN]
8 ;
9RESED N BPSEL
10 ;
11 I '$D(@(VALMAR)) G XRESED
12 D FULL^VALM1
13 ;
14 ;Select the claim to resubmit
15 W !,"Enter the line number for the claim to be resubmitted."
16 S BPSEL=$$ASKLINE("Select item","Please select a SINGLE claim only when using the Resubmit w/EDITS action option.")
17 I BPSEL<1 S VALMBCK="R" G XRESED
18 ;
19 ;Attempt to resubmit the claim, update the content of the screen, and display
20 ;only if claim submitted successfully
21 I $$DOSELCTD(BPSEL) D REDRAW^BPSSCRUD("Updating screen for resubmitted claim...")
22 E S VALMBCK="R"
23 ;
24XRESED Q
25 ;
26 ;Attempt to Edit and Resubmit Selected Claim
27 ;
28 ; Input Value -> BPRXI - Entry with ptr to BPS TRANSACTION file
29 ;
30 ; Return Value -> 0 - Claim was not resubmitted
31 ; 1 - Claim was resubmitted
32 ;
33DOSELCTD(BPRXI) N BP02,BP59,BPBILL,BPCLTOT,BPDFN,BPDOSDT,BPOVRIEN,BPQ,BPRXIEN,BPRXR,BPSTATUS,BPUPDFLG
34 S (BPQ)=""
35 S (BPCLTOT,BPUPDFLG)=0
36 ;
37 ;Pull BPS TRANSACTION/BPS CLAIMS entries
38 S BP59=$P(BPRXI,U,4) I BP59="" W !!,"No Initial Claim Submission Found - Data Elements are NOT Editable for Re-Submission",! G XRES
39 S BP02=+$P($G(^BPST(BP59,0)),U,4) I 'BP02 W !!,"No Initial Claim Submission Found - Data Elements are NOT Editable for Re-Submission",! G XRES
40 ;
41 ;Write Form Feed
42 W @IOF
43 ;
44 ;Display selected claim and ask to submit
45 S BPDFN=+$P($G(^BPST(BP59,0)),U,6)
46 W !,"You've chosen to RESUBMIT the following prescription for "_$E($$PATNAME^BPSSCRU2(BPDFN),1,13)
47 W !,@VALMAR@(+$P(BPRXI,U,5),0)
48 S BPQ=$$YESNO^BPSSCRRS("Are you sure?(Y/N)")
49 I BPQ'=1 S BPQ="^" G XRES
50 ;
51 ;Check to make sure claim can be Resubmitted w/EDITS
52 S BPRXIEN=$P(BP59,".")
53 S BPRXR=+$E($P(BP59,".",2),1,4)
54 I $$RXDEL^BPSOS($P(BP59,".",1),+$E($P(BP59,".",2),1,4)) W !!,"The claim: ",!,@VALMAR@(+$P(BPRXI,U,5),0),!,"cannot be Resubmitted w/EDITS because it has been deleted in Pharmacy.",! G XRES
55 S BPSTATUS=$P($$CLAIMST^BPSSCRU3(BP59),U)
56 I BPSTATUS["IN PROGRESS" W !!,"The claim: ",!,@VALMAR@(+$P(BPRXI,U,5),0),!,"is still In Progress and cannot be Resubmitted w/EDITS",! G XRES
57 I BPSTATUS'["E REJECTED" W !!,"The claim: ",!,@VALMAR@(+$P(BPRXI,U,5),0),!,"is NOT Rejected and cannot be Resubmitted w/EDITS",! G XRES
58 ;
59 ;Prompt for EDIT Information
60 S BPOVRIEN=$$PROMPTS(BP59,BP02) I BPOVRIEN=-1 G XRES
61 ;
62 ;Retrieve DOS
63 S BPDOSDT=$$DOSDATE^BPSSCRRS(BPRXIEN,BPRXR)
64 ;
65 ;Resubmit Claim
66 S BPBILL=$$EN^BPSNCPDP(BPRXIEN,BPRXR,BPDOSDT,"ERES","","ECME RESUBMIT","",BPOVRIEN)
67 ;
68 ;Print Return Value Message
69 W !!
70 W:+BPBILL>0 $S(+BPBILL=10:"Reversal but no Resubmit:",1:"Not Processed:"),!," "
71 ;
72 ;Change Return Message for SC/EI
73 S:$P(BPBILL,U,2)="NEEDS SC DETERMINATION" $P(BPBILL,U,2)="NEEDS SC/EI DETERMINATION"
74 W $P(BPBILL,U,2)
75 ;
76 ;0 Prescription/Fill successfully submitted to ECME
77 ;1 ECME did not submit prescription/fill
78 ;2 IB says prescription/fill is not ECME billable or the data returned from IB is not valid
79 ;3 ECME closed the claim but did not submit it to the payer
80 ;4 Unable to queue the ECME claim
81 ;5 Invalid input
82 ;10 Reversal Processed But Claim Was Not Resubmitted
83 ;
84 I +BPBILL=0 D
85 . D ECMEACT^PSOBPSU1(+BPRXIEN,+BPRXR,"Claim resubmitted to 3rd party payer: ECME USER's SCREEN")
86 . S BPUPDFLG=1,BPCLTOT=1
87XRES I BPCLTOT W !,BPCLTOT," claim",$S(BPCLTOT'=1:"s have",1:" has")," been resubmitted.",!
88 D PAUSE^VALM1
89 Q BPUPDFLG
90 ;
91 ;Enter EDIT information for claim
92 ;
93 ; Input Values -> BP59 - The BPS TRANSACTION entry
94 ; BP02 - The BPS CLAIMS entry
95 ; Output Value -> BPQ - -1 - The user chose to quit
96 ; "" - The user completed the EDITS
97PROMPTS(BP59,BP02) N %,BP300,BPCLCD,BPFDA,BPFLD,BPOVRIEN,BPMED,BPMSG,BPPSNCD,BPPREAUT,BPPRETYP,BPQ,BPRELCD,DIC,DIR,DIROUT,DTOUT,DUOUT,X,Y
98 ;
99 S BPQ=""
100 ;
101 ;Pull Information from Claim
102 S BP300=$G(^BPSC(BP02,300))
103 S BPRELCD=$TR($E($P(BP300,U,6),3,99)," ")
104 S BPPSNCD=$TR($E($P(BP300,U,3),3,99)," ")
105 S (BPPRETYP,BPPREAUT,BPCLCD)="",BPMED=0 F S BPMED=$O(^BPSC(BP02,400,BPMED)) Q:'BPMED D I BPPREAUT]"",BPCLCD]"" Q
106 .N BP460 S BP460=$G(^BPSC(BP02,400,BPMED,460))
107 .S:BPPREAUT="" BPPREAUT=$TR($E($P(BP460,U,2),3,99)," "),BPPRETYP=$TR($E($P(BP460,U),3,99)," ")
108 .S:BPCLCD="" BPCLCD=$TR($E($P($G(^BPSC(BP02,400,BPMED,400)),U,20),3,99)," ")
109 ;
110 W ! S DIR(0)="FO^1:1",DIR("A")="Relationship Code"
111 S DIR("B")=BPRELCD
112 K DIR("?")
113 S DIR("?",1)="Select the relationship code that describes the relationship this patient has"
114 S DIR("?",2)="to the holder of this insurance policy. The standard NCPDP Patient"
115 S DIR("?",3)="Relationship Code list is shown below. However, it is important to note"
116 S DIR("?",4)="that some payers use their own set of codes for this field so the field"
117 S DIR("?",5)="should be populated based upon the payer's expectations."
118 S DIR("?",6)=" "
119 S DIR("?",7)="Choose from:"
120 S DIR("?",8)=" 0 Not Specified"
121 S DIR("?",9)=" 1 Cardholder"
122 S DIR("?",10)=" 2 Spouse"
123 S DIR("?",11)=" 3 Child"
124 S DIR("?")=" 4 Other"
125 D ^DIR
126 I $G(DTOUT)!$G(DUOUT) S BPQ=-1 G XPROMPTS
127 S BPRELCD=Y
128 ;
129 ;Person Code
130 K DIR("?") S DIR(0)="FO^1:3",DIR("A")="Person Code",DIR("?")="Enter the Specific Person Code Assigned to the Patient by the Payer"
131 S DIR("B")=BPPSNCD
132 D ^DIR
133 I $G(DTOUT)!$G(DUOUT) S BPQ=-1 G XPROMPTS
134 S BPPSNCD=Y
135 ;
136 ;Pre-Authorization
137 K DIR("?") S DIR(0)="FO^1:11",DIR("A")="Prior Authorization Number",DIR("?")="Enter the Number Submitted by the Provider to Identify the Prior Authorization"
138 S DIR("B")=BPPREAUT
139 D ^DIR
140 I $G(DTOUT)!$G(DUOUT) S BPQ=-1 G XPROMPTS
141 S BPPREAUT=Y
142 ;
143 ;Prior-Authorization Type Code
144 N X,DIC,Y
145 S DIC("B")=+BPPRETYP
146 S DIC(0)="QEAM",DIC=9002313.82461,DIC("A")="Prior Authorization Type Code: "
147 D ^DIC
148 ;
149 ;Check for "^" or timeout
150 I ($G(DUOUT)=1)!($G(DTOUT)=1)!(Y=-1) S BPQ=-1 K X,DIC,Y G XPROMPTS
151 S BPPRETYP=$P(Y,U,2)
152 K X,DIC,Y
153 ;
154 ;Submission Clarification Code
155 N X,DIC,Y
156 S DIC("B")=+BPCLCD
157 S DIC(0)="QEAM",DIC=9002313.8242,DIC("A")="Submission Clarification Code: "
158 D ^DIC
159 ;
160 ;Check for "^" or timeout
161 I ($G(DUOUT)=1)!($G(DTOUT)=1)!(Y=-1) S BPQ=-1 K X,DIC,Y G XPROMPTS
162 S BPCLCD=$P(Y,U,2)
163 K X,DIC,Y
164 ;
165 ;Ask to proceed
166 W ! S BPQ=$$YESNO^BPSSCRRS("Are you sure?(Y/N)")
167 I BPQ'=1 S BPQ=-1 G XPROMPTS
168 ;
169 ;Save into BPS NCPDP OVERRIDES (#9002313.511)
170 S BPFDA(9002313.511,"+1,",.01)=BP59
171 D NOW^%DTC
172 S BPFDA(9002313.511,"+1,",.02)=%
173 S BPFLD=$O(^BPSF(9002313.91,"B",303,"")) I BPFLD]"" S BPFDA(9002313.5111,"+2,+1,",.01)=BPFLD,BPFDA(9002313.5111,"+2,+1,",.02)=BPPSNCD
174 S BPFLD=$O(^BPSF(9002313.91,"B",306,"")) I BPFLD]"" S BPFDA(9002313.5111,"+3,+1,",.01)=BPFLD,BPFDA(9002313.5111,"+3,+1,",.02)=BPRELCD
175 S BPFLD=$O(^BPSF(9002313.91,"B",462,"")) I BPFLD]"" S BPFDA(9002313.5111,"+4,+1,",.01)=BPFLD,BPFDA(9002313.5111,"+4,+1,",.02)=BPPREAUT
176 S BPFLD=$O(^BPSF(9002313.91,"B",461,"")) I BPFLD]"" S BPFDA(9002313.5111,"+5,+1,",.01)=BPFLD,BPFDA(9002313.5111,"+5,+1,",.02)=BPPRETYP
177 S BPFLD=$O(^BPSF(9002313.91,"B",420,"")) I BPFLD]"" S BPFDA(9002313.5111,"+6,+1,",.01)=BPFLD,BPFDA(9002313.5111,"+6,+1,",.02)=BPCLCD
178 D UPDATE^DIE("","BPFDA","BPOVRIEN","BPMSG")
179 ;
180 I $D(BPMSG("DIERR")) W !!,"Could Not Save Override information into BPS NCPDP OVERRIDES FILES",! S BPQ=-1 G XPROMPTS
181 ;
182XPROMPTS S BPOVRIEN=$S(BPQ=-1:BPQ,$G(BPOVRIEN(1))]"":BPOVRIEN(1),1:-1)
183 Q BPOVRIEN
184 ;
185 ;Prompt User for Claim to Resubmit (w/EDITS)
186 ;
187 ; Input values -> BPROMPT - prompt string
188 ; BPERRMES - the message to display when the user tries
189 ; to make multi line selection (optional)
190 ; Piece
191 ;output values -> 1 - 1 = okay, <0 = errors, 0 = quit
192 ; 2 - patient ien #2
193 ; 3 - insurance ien #36
194 ; 4 - ptr to #9002313.59
195 ; 5 - 1st line for index(es) in LM "VALM" array
196 ; 6 - patient's index
197 ; 7 - claim's index
198ASKLINE(BPROMPT,BPERRMES) ;
199 N BPRET,BPCNT
200 S BPRET="",BPCNT=0
201 F S BPRET=$$SELLINE^BPSSCRU4(BPROMPT,"C",VALMAR,"") Q:BPRET'<0 D
202 . ;
203 . I BPCNT<1 S BPCNT=BPCNT+1 W !
204 . E S BPCNT=0 D RE^VALM4
205 . I BPRET=-1 W "Invalid line number" ; (invalid Patient summary line)"
206 . I BPRET=-8 W $S($G(BPERRMES)]"":BPERRMES,1:" Invalid line number")
207 . I BPRET=-4 W "Invalid line number" ; (invalid RX line)"
208 . I BPRET=-2 W "Please select Patient's summary line."
209 . I BPRET=-3 W "Please specify RX line."
210 . I ",-1,-8,-4,-2,-3,"'[(","_BPRET_",") W "Incorrect format." ; Corrupted array (",BPRET,")"
211 Q BPRET
Note: See TracBrowser for help on using the repository browser.