source: FOIAVistA/tag/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEPTC.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 8.1 KB
Line 
1IBCEPTC ;ALB/TMK - EDI PREVIOUSLY TRANSMITTED CLAIMS ; 4/12/05 11:15am
2 ;;2.0;INTEGRATED BILLING;**296,320,348,349**;21-MAR-94;Build 46
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5EN ; Main entrypoint
6 ; IBDT1,IBDT2 = last transmit date range to use
7 ; IBSORT = primary sort criteria to use B=BATCH #,I=INS CO NAME
8 ; IBFORM = form type to limit selection to U=UB-04,C=CMS-1500,B=BOTH
9 ; IBCRIT = the additional sort criteria needed
10 ; IBPTCCAN = whether or not to include cancelled claims
11 ; IBRCBFPC = whether or not to include force print @ clearinghouse
12 ; ^TMP("IB_PREV_CLAIM_INS",$J) = 1 for specific ins co/null for all
13 ; ^($J,1,ien)="" for ien of each ins co selected
14 ; ^($J,2,payer ID,ien)="" if selected
15 ; IBREP = format output should be put in R=report,S=Listman
16 ;
17 N DIR,DIC,X,Y,Z,Z0,Z1,IBHOW,IBACT,IBCT,IBREP,IBCRIT,IBDT1,IBDT2
18 N IBFORM,IBOK,IBQUIT,IBSORT,IBY,DTOUT,DUOUT,%ZIS,ZTSAVE,ZTRTN,ZTDESC
19 N POP,IBPAYER,EDI,INST,PROF,IBPTCCAN,DIROUT,DIRUT,DTOUT,DUOUT,IBRCBFPC
20 ;
21Q1 ;
22 W !!,"*** Please Note ***"
23 W ?20,"2 '^' are needed to abort this option (^^)"
24 W !?20,"1 '^' brings you back to the previous prompt (^)"
25 W !
26 ;
27 S DIR(0)="SA^C:Claim;B:Batch;L:List",DIR("A")="Select By: (C)laim, (B)atch or see a (L)ist to pick from?: ",DIR("B")="List"
28 D ^DIR K DIR
29 I $D(DTOUT)!$D(DUOUT) G ENQ
30 S IBHOW=Y
31 I IBHOW="L" G Q1A
32 ;
33 S IBQUIT=0,IBCT=0
34 K ^TMP($J,IBHOW)
35 F D Q:IBQUIT
36 . I IBHOW="C" S DIR("A")="Select a"_$S(IBCT:"nother",1:"")_" Claim: ",DIR(0)="PA^364:AEMQZ",DIR("S")="I '$P(^(0),U,7),'$O(^IBA(364,""B"",+^(0),Y))"
37 . I IBHOW="B" S DIR("A")="Select a"_$S(IBCT:"nother",1:"")_" Batch: ",DIR(0)="PA^IBA(364.1,:AEMQ^W "" "",$P(^(0),U,3),"" Claims""",DIR("S")="I '$P(^(0),U,14)"
38 . S DIR("?")="^D SELDSP^IBCEPTC(IBHOW)"
39 . S:IBCT $P(DIR(0),U)=$P(DIR(0),U)_"O" ; Optional prompt after one is selected
40 . D ^DIR K DIR
41 . I Y'>0 S IBQUIT=$S(X="^":2,X="^^":3,1:1) Q
42 . S IBY=$S(IBHOW="C":+Y,1:""),Y=$S(IBHOW="C":+Y(0),1:Y)
43 . I '$D(^TMP($J,IBHOW,+Y)) S IBCT=IBCT+1,^TMP($J,IBHOW,+Y)=IBY
44 ;
45 G:IBQUIT=3 ENQ
46 G:IBQUIT=2!'$O(^TMP($J,IBHOW,0)) Q1
47 S Z=0
48 I IBHOW="C" F S Z=$O(^TMP($J,"C",Z)) Q:'Z S ^TMP("IB_PREV_CLAIM_SELECT",$J,Z,0)=^TMP($J,"C",Z)
49 I IBHOW="B" S (Z,IBCT)=0 F S Z=$O(^TMP($J,"B",Z)) Q:'Z D
50 . S Z0=0 F S Z0=$O(^IBA(364,"C",Z,Z0)) Q:'Z0 S Z1=+$G(^IBA(364,Z0,0)) I Z1,'$D(^TMP("IB_PREV_CLAIM_SELECT",$J,Z1,0)) S ^(0)=Z0,IBCT=IBCT+1
51 S ^TMP("IB_PREV_CLAIM_SELECT",$J)=IBCT
52 D RESUB^IBCEPTC3
53 G ENQ
54 ;
55Q1A K ^TMP("IB_PREV_CLAIM_INS",$J)
56 S DIR(0)="SA^A:All Payers;S:Selected Payers"
57 S DIR("A")="Run for (A)ll Payers or (S)elected Payers?: " S DIR("B")="Selected Payers"
58 W !!,"PAYER SELECTION:" D ^DIR K DIR
59 I X="^^" G ENQ
60 I $D(DTOUT)!$D(DUOUT) G Q1
61 ;
62 I Y="A" S ^TMP("IB_PREV_CLAIM_INS",$J)="" G Q2
63 ;
64 ; esg - 11/21/05 - patch 320 question
65 W !
66 S DIR(0)="Y",DIR("A")=" Include all payers with the same electronic Payer ID",DIR("B")="Yes" D ^DIR K DIR
67 I $D(DIROUT) G ENQ
68 I $D(DIRUT) G Q1A
69 S IBPAYER=Y
70 W !
71 ;
72 S ^TMP("IB_PREV_CLAIM_INS",$J)=1
73 S IBQUIT=0
74 F D Q:IBQUIT
75 . S DIC(0)="AEMQ",DIC=36,DIC("A")=" Select Insurance Company: "
76 . I $O(^TMP("IB_PREV_CLAIM_INS",$J,1,"")) S DIC("A")=" Select Another Insurance Company: "
77 . S DIC("W")="D INSLIST^IBCEMCA(Y)"
78 . D ^DIC K DIC ; lookup
79 . I X="^^" S IBQUIT=2 Q ; user entered "^^"
80 . I +Y'>0 S IBQUIT=1 Q ; user is done
81 . W !
82 . S ^TMP("IB_PREV_CLAIM_INS",$J,1,+Y)=""
83 . I 'IBPAYER Q
84 . S EDI=$$UP^XLFSTR($G(^DIC(36,+Y,3)))
85 . S PROF=$P(EDI,U,2),INST=$P(EDI,U,4)
86 . I PROF'="",PROF'["PRNT" S ^TMP("IB_PREV_CLAIM_INS",$J,2,PROF,+Y)=""
87 . I INST'="",INST'["PRNT" S ^TMP("IB_PREV_CLAIM_INS",$J,2,INST,+Y)=""
88 . Q
89 ;
90 I IBQUIT=2 G ENQ
91 ;
92 I '$O(^TMP("IB_PREV_CLAIM_INS",$J,1,0)) D G Q1A
93 . W *7,!!?3,"No payers have been selected. Please try again."
94 . Q
95 ;
96Q2 S DIR(0)="SA^C:CMS-1500;U:UB-04;B:Both",DIR("B")="Both"
97 S DIR("A")="Run for (U)B-04, (C)MS-1500 or (B)oth: "
98 W !!,"BILL FORM TYPE SELECTION:" D ^DIR K DIR
99 I X="^^" G ENQ
100 I $D(DTOUT)!$D(DUOUT) G Q1A
101 S IBFORM=Y
102 ;
103Q3 S DIR(0)="DA^0:9999999:EPX",DIR("A")="Start with Date Last Transmitted: "
104 S DIR("?",1)="This is the earliest date on which a batch that you want to include on this",DIR("?",2)=" report was last transmitted. You may choose a maximum date range of 90 days.",DIR("?")=" "
105 W !!,"LAST BATCH TRANSMIT DATE RANGE SELECTION:" D ^DIR K DIR
106 I X="^^" G ENQ
107 I $D(DTOUT)!$D(DUOUT) G Q2
108 S IBDT1=Y
109 S IBDT2=$$FMADD^XLFDT(IBDT1,90) I IBDT2>DT S IBDT2=DT
110 S DIR("?",1)="This is the latest date on which a batch that you want to include on this",DIR("?",2)=" report was last transmitted. You may choose a maximum date range of 90 days.",DIR("?")=" "
111 S DIR("B")=$$FMTE^XLFDT(IBDT2,2),DIR(0)="DA^"_IBDT1_":"_IBDT2_":EPX"
112 S DIR("A")="Go to Date Last Transmitted:("_$$FMTE^XLFDT(IBDT1,2)_"-"_$$FMTE^XLFDT(IBDT2,2)_"): " D ^DIR K DIR
113 I X="^^" G ENQ
114 I $D(DTOUT)!$D(DUOUT) G Q3
115 S IBDT2=Y
116 ;
117Q4 ; Additional selection criteria
118 S DIR(0)="SAO^1:MRA Secondary Only;2:Primary Claims Only;3:Secondary Claims Only;4:Claims Previously Printed at Clearinghouse"
119 S DIR("A",1)="ADDITIONAL SELECTION CRITERIA:",DIR("A",2)=" ",DIR("A",3)="1 - MRA Secondary Only",DIR("A",4)="2 - Primary Claims Only",DIR("A",5)="3 - Secondary Claims Only"
120 S DIR("A",6)="4 - Claims Sent to Print at Clearinghouse Only",DIR("A",7)=" ",DIR("A")="Select Additional Limiting Criteria (optional): "
121 S DIR("?")="Select one of the listed criteria to further limit the claims to include"
122 W ! D ^DIR K DIR
123 I X="^^" G ENQ
124 I $D(DTOUT)!$D(DUOUT) G Q3
125 S IBCRIT=Y
126 ;
127Q41 ; Ask user if they want to include cancelled claims
128 S DIR(0)="Y",DIR("B")="No",DIR("A")="Would you like to include cancelled claims"
129 W ! D ^DIR K DIR
130 I X="^^" G ENQ
131 I $D(DIRUT) G Q4
132 S IBPTCCAN=Y
133 ;
134Q42 ; Include claims that are forced to print at clearinghouse?
135 S DIR(0)="Y",DIR("B")="No",DIR("A")="Would you like to include claims Forced to Print at the Clearinghouse"
136 W ! D ^DIR K DIR
137 I X="^^" G ENQ
138 I $D(DIRUT) G Q41
139 S IBRCBFPC=Y
140 ;
141Q5 S DIR("L",1)="Select one of the following: ",DIR("L",2)=" ",DIR("L",3)=$J("",10)_"1 Batch By Last Transmitted Date (Claims within a Batch)",DIR("L",4)=$J("",10)_"2 Current Payer (Insurance Company)"
142 S DIR("L",5)=" "
143 S DIR(0)="SA^1:Batch By Last Transmitted Date (Claims within a Batch);2:Current Payer (Insurance Company)",DIR("B")="Current Payer"
144 S DIR("A")="Sort By: "
145 W ! D ^DIR K DIR
146 I X="^^" G ENQ
147 I $D(DTOUT)!$D(DUOUT) G Q42
148 S IBSORT=Y
149 ;
150Q6 S DIR(0)="SA^R:Report;S:Screen List"
151 S DIR("A")="Do you want a (R)eport or a (S)creen List format?: "
152 S DIR("B")="Screen List"
153 W ! D ^DIR K DIR
154 I X="^^" G ENQ
155 I $D(DTOUT)!$D(DUOUT) G Q5
156 S IBREP=Y
157 ;
158 I IBREP="S" D LIST^IBCEPTC0 G ENQ
159 ;
160Q7 ; Select device
161 F S IBACT=0 D DEVSEL(.IBACT) Q:IBACT
162 I IBACT=99 G ENQ
163 U IO
164 D LIST^IBCEPTC0
165 ;
166ENQ K ^TMP("IB_PREV_CLAIM_INS",$J),^TMP("IB_PREV_CLAIM_SELECT",$J)
167 Q
168 ;
169DEVSEL(IBACT) ;
170 N DIR,POP,X,Y,ZTRTN,ZTSAVE
171 W !!,"You will need a 132 column printer for this report!"
172 S %ZIS="QM" D ^%ZIS I POP S IBACT=99 G DEVSELQ
173 I $G(IOM),IOM<132 S IBOK=1 D I 'IBOK S IBACT=0 G DEVSELQ
174 . S DIR(0)="YA",DIR("A",1)="This report requires output to a 132 column device.",DIR("A",2)="The device you have chosen is only set for "_IOM_".",DIR("A")="Are you sure you want to continue?: ",DIR("B")="No"
175 . W ! D ^DIR K DIR
176 . I Y'=1 S IBOK=0 W !
177 I $D(IO("Q")) D S IBACT=99 G DEVSELQ
178 . K IO("Q")
179 . S ZTRTN="LIST^IBCEPTC0",ZTSAVE("IBCRIT(")="",ZTSAVE("IB*")="",ZTSAVE("^TMP(""IB_PREV_CLAIM_INS"",$J)")="",ZTSAVE("^TMP(""IB_PREV_CLAIM_INS"",$J,")="",ZTDESC="IB - Previously Transmitted Claims Report"
180 . D ^%ZTLOAD K ZTSK D HOME^%ZIS
181 S IBACT=1
182DEVSELQ Q
183 ;
184SELDSP(IBHOW) ; Display list of selected claims/batches
185 ; IBHOW = "C" for claims "B" for batches
186 N Z,DIR,CT,QUIT
187 I '$O(^TMP($J,IBHOW,0)) Q
188 S (CT,QUIT)=0
189 W !!,$S(IBHOW="C":"Claims",1:"Batches")," Already Selected:"
190 S Z=0 F S Z=$O(^TMP($J,IBHOW,Z)) Q:'Z!QUIT S Z0=$G(^(Z)) D Q:QUIT
191 . I IBHOW="C" W !,?3,$P($G(^DGCR(399,Z,0)),U) Q
192 . W !,?3,$P($G(^IBA(364.1,Z,0)),U)," ",$P(^(0),U,3)," Claims"
193 . S CT=CT+1
194 . I '(CT#10),$O(^TMP($J,IBHOW,Z)) S DIR("A")="Press return for more or '^' to exit ",DIR(0)="EA" W ! D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S QUIT=1
195 W !
196 Q
197 ;
Note: See TracBrowser for help on using the repository browser.