source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCRCRT.m@ 635

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

initial load of FOIAVistA 6/30/08 version
File size: 8.3 KB
Line 
1RCRCRT ;ALB/CMS - RC TRANSACTION PROC OVER INTERFACE ;8/27/97 11:01 AM
2V ;;4.5;Accounts Receivable;**63,147,168,169,189,159**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4EN ;Enter at top with the Transaction Type from RC Server via Taskman
5 ;Create the AR Transaction or send Transaction/Comment LOG to RC.
6 ;Input: RCSITE,RCBDT,RCEDT,RCJOB,RCXTYP,RCVAR,RCXMY
7 ;Input: XTMP(RCXTYP,RCJOB,
8 ;RCXTYP:
9 ; CL - Comment Log send all Comments to RC
10 ; TR - Send all Transactions to RC
11 ; DA-1 - DA-3 Decrease Adj.,Bill Status Collected/Close,Contractual Adjustment Yes, Tran. Comment
12 ; DA-4 - Decrease Adj.,Bill Status Cancellation,Contractual Adjustment Yes, Tran. Comment
13 ; DA-5 - DA-10 Decrease Adj.,Bill Status Cancellation,Notify IB of Cancelation, Tran. Comment
14 ; TJ-1 - TJ-5 Termination by RC,Bill Status Write-off, Tran. Comment
15 ; RT - Returned by RC/DOJ,Delete Referral Date in 430
16 ;
17 N PRCABN,PRCABN0,RCAMT,RCCAT,RCBNAM,RCD,RCERR,RCFL,RCL,RCCMSG,RCTR,RCTYP,XMZ
18 K ^TMP("RCRCAT",$J,"XM") S RCCMSG=""
19 S RCXMZ=$P($G(^XTMP($G(RCXTYP,"UNK"),+$G(RCXMZ),0)),U,4) I 'RCXMZ G ENQ
20 S RCL=0 F S RCL=$O(^XTMP(RCXTYP,RCXMZ,RCL)) Q:'RCL S RCD=^(RCL) D
21 .I RCD["$$RC$" S RCTYP=$P(RCD,"$",4) Q
22 .I RCD["$END$" Q
23 .S RCBNAM=$P(RCD,U,1),RCAMT=+$P(RCD,U,2)
24 .S PRCABN=$O(^PRCA(430,"B",RCBNAM,0))
25 .I 'PRCABN S RCCMSG="E;Bill "_RCBNAM_" does not exist at this medical center" Q
26 .S RCD=$$REFST^RCRCUTL(PRCABN)
27 .I ('RCD)!("RCDCDOJ"'[$P(RCD,U,2)) S RCCMSG="E;Bill "_RCBNAM_" is not currently referred to RC." Q
28 .I (RCTYP="CL")!(RCTYP="TR") Q
29 .S PRCABN0=$G(^PRCA(430,PRCABN,0))
30 .I $P(PRCABN0,U,8)'=16 S RCCMSG="E;Bill "_RCBNAM_" is no longer Active at medical center." Q
31 .D RCCAT^RCRCUTL(.RCCAT)
32 .I +$G(RCCAT(+$P(PRCABN0,U,2)))'=1 S RCCMSG="E;Bill "_RCBNAM_" Category is not electronically referred." Q
33 .I "TJDA"[$E(RCTYP,1,2) D
34 ..I RCAMT'=+$P(RCD,U,3) S RCCMSG="E;Bill "_RCBNAM_" for $"_RCAMT_" does not equal AR Referred Amount of $"_+$P(RCD,U,3)_". AR Site Problem!" Q
35 ..S RCD=+$P($$BILL^RCJIBFN2(PRCABN),U,3)
36 ..I RCAMT'=RCD S RCCMSG="E;Bill "_RCBNAM_" for $"_RCD_" does not equal the AR Current Balance. RC may need to Return Bill!" Q
37 ;
38 I RCCMSG]"" S XMZ=+RCXMZ D SEND^RCRCSRV G ENQ
39 ;
40 I (RCTYP="CL")!(RCTYP="TR") D TR G ENQ
41 ;
42 S RCTR=$S(RCTYP="RT":6,$E(RCTYP,1,2)="DA":35,$E(RCTYP,1,2)="TJ":29,1:0)
43 I RCTR D TRAN
44 ;
45ENQ K ^XTMP(RCXTYP,RCXMZ)
46 K RCSITE,RCBDT,RCEDT,RCJOB,RCXTYP,RCVAR,RCXMY,RCXMZ
47 Q
48 ;
49REF ;Entry point from Review/Refer Protocol
50 ;Refer to RC (3) or Re-Establish to RC/DOJ (5) send to RC
51 ;Input: PRCABN, RCCOM (Optional)
52 N DA,DIE,DR,PRCAEN,RCBAL,RCI,RCTYP,RC7,X,Y,RCCOM1
53 S DA=PRCABN,DIC="^PRCA(430," D LCK^PRCAUPD
54 S RCCODE="RC"
55 S RCTYP=$S($P($G(^PRCA(430,PRCABN,6)),U,4):5,1:3)
56 S RCCOM1=$P($G(^PRCA(430,PRCABN,6)),U,22,23)
57 S:RCCOM1 RCCOM1=$$EXTERNAL^DILFD(430,68.94,"",$P(RCCOM1,"^"))_$S($L($P(RCCOM1,"^",2)):" - "_$P(RCCOM1,"^",2),1:"")
58 S RCBAL=0,RC7=$G(^PRCA(430,PRCABN,7))
59 F RCI=1:1:5 S RCBAL=RCBAL+$P(RC7,U,RCI)
60 D SETTR^PRCAUTL,PATTR^PRCAUTL I '$D(PRCAEN) G REFQ
61 S DA=PRCAEN,DIE="^PRCA(433,",DR="[PRCAC RC REFER]" D ^DIE
62 I $G(RCCOM)]"" D COM(PRCAEN,RCCOM)
63 S DR=$S(RCTYP=5:"68.2////"_DT_";",1:"")_"64////"_DT_";65////^S X=""RC"";66////"_RCBAL
64 S DA=PRCABN,DIE="^PRCA(430," D ^DIE
65REFQ L -^PRCA(430,PRCABN)
66 Q
67 ;
68COM(PRCAEN,RCCOM,ERR) ;Update AR Transaction Comments
69 N X,Y
70 I '$D(^PRCA(433,+$G(PRCAEN),0)) G COMQ
71 S COM(1,1)=RCCOM
72 S:$L($G(RCCOM1)) COM(1,2)=RCCOM1
73 D WP^DIE(433,PRCAEN_",",41,"A","COM(1)","ERR(0)")
74COMQ Q
75 ;
76INC ;Increase Referred TP Bill called by Protocol
77 N DA,DIE,DIR,DR,DTOUT,DUOUT,PRCA,PRCABN,PRCAEN,RCBAL,RCBN,RCEN,RCOUT,RCSP,RCY,X,Y
78 D FULL^VALM1
79 I '$O(^TMP("RCRCAL",$J,"SEL",0)) W !!,"NO SELECTED ITEMS FROM LIST!" G INCQ
80 W !! S DIR("A",1)="Increasing bill(s) on highlighted Selection List "
81 S DIR("A")="Okay to continue ",DIR("?")="Enter Yes to Continue"
82 D ASK^RCRCACP K DIR I $G(Y)'=1 G INCQ
83 S RCY=0 F S RCY=$O(^TMP("RCRCAL",$J,"SEL",RCY)) Q:('RCY)!($G(RCOUT)) D
84 . S PRCABN=+$P($G(^TMP("RCRCALX",$J,RCY)),U,2)
85 . I '$D(^PRCA(430,PRCABN,0)) Q
86 . W !!,?5,"Patient",?22,"Bill #",?33,"Cat.",?62,"Orig Amt",?72,"Cur Bal"
87 . W !,$G(^TMP("RCRCAL",$J,RCY,0))
88 . ; get the balance before the adjustment
89 . S RCBAL=+$P($$BILL^RCJIBFN2(PRCABN),U,3)
90 . ; create increase adjustment
91 . D ADJBILL^RCBEADJ("INCREASE",PRCABN)
92 . ; get the balance after the adjustment
93 . S X=+$P($$BILL^RCJIBFN2(PRCABN),U,3)
94 . I RCBAL=X W !!,"** Bill not Increased **",! G INCX
95 . S RCBAL=X,DA=PRCABN,DIE="^PRCA(430,",DR="66///^S X="_RCBAL D ^DIE
96 . S RCSP="",RCBAL=$J(RCBAL,".",2),$E(RCSP,10-$L($E(RCBAL,1,10)))=" ",RCBAL=RCSP_RCBAL
97 . D FLDTEXT^VALM10(RCY,"CURAMT",RCBAL)
98 . I '$G(PRCAEN) S PRCAEN=$O(^PRCA(433,"C",PRCABN,9999999),-1)
99 . D PF^RCRCAT("I")
100INCX . K DIR,PRCA,PRCAEN
101 . I '$O(^TMP("RCRCAL",$J,"SEL",RCY)) Q
102 . W !! S DIR("A")="Continue Increasing Selected Bills ",DIR("?")="Enter Yes to Continue to next bill"
103 . D ASK^RCRCACP K DIR I $G(Y)'=1 S RCOUT=1
104 ;
105INCQ K DIR D PAUSE^VALM1 S VALMBCK="R"
106 Q
107 ;
108TR ;Send Transactions or Comment Log to RC for bill
109 N PRCA,PRCAEN,RCI,RCXCNT,X,Y,RCSITE,RCDOM,RCBDIV,RCDIV S RCXCNT=0
110 D BNVAR^RCRCUTL(PRCABN)
111 D DEBT^RCRCUTL(PRCABN)
112 S RCSITE=$$SITE^RCMSITE
113 D RCDIV^RCRCDIV(.RCDIV)
114 S PRCAEN=0 F S PRCAEN=$O(^PRCA(433,"C",PRCABN,PRCAEN)) Q:'PRCAEN D
115 .I RCTYP="CL",$P($G(^PRCA(433,PRCAEN,1)),U,2)'=45 Q
116 .D SET^RCRCAT1
117 ;
118 I '$O(^TMP("RCRCAT",$J,"XM",PRCABN,0)) D
119 .S ^TMP("RCRCAT",$J,"XM",PRCABN,1,1)="BN1^"_PRCA("BNAME")_U_PRCA("DEBTNM")
120 .S ^TMP("RCRCAT",$J,"XM",PRCABN,1,2)="TR1^0^0"
121 .S ^TMP("RCRCAT",$J,"XM",PRCABN,1,3)="COMMENT: No "_$S(RCTYP="CL":"Comment ",1:"")_"Transactions at site for Bill "_PRCA("BNAME")_"."
122 I $G(RCDIV(0)) S RCBDIV=$$DIV^IBJDF2(PRCABN) S X=0 F S X=$O(RCDIV(X)) Q:'X D
123 .I X=+RCBDIV S RCDOM=$P(RCDIV(X),"^",6)
124 I $G(RCDOM)="" S RCDOM=$$RCDOM^RCRCUTL
125 D SEND^RCRCAT
126 K ^TMP("RCRCAT",$J,"XM")
127TRQ Q
128 ;
129TRAN ;Process Termination, Returned and Decrease Transactions from RC
130 ;Input: PRCABN,PRCABN0,RCTYP,RCBNAM,RCAMT,RCTR=6,29 or 35
131 ;
132 N DA,DIC,DIE,DR,LN,PRCA,PRCAA2,PRCAEN,PRCAQNM,X,XMCHAN,XMZ,XMY,XMDUZ,XMSUB,XMTEXT,Y
133 N RCAMT,RCAD,RCCA,RCCC,RCCOM,RCDT,RCERR,RCI,RCIB,RCMF,RCO,RCPB
134 S DA=PRCABN,DIC="^PRCA(430,",XMCHAN=1 D LCK^PRCAUPD
135 D SETTR^PRCAUTL,PATTR^PRCAUTL I '$D(PRCAEN) Q
136 S RCI=$O(^RCT(349.4,"B",RCTYP,0)),RCI=$G(^RCT(349.4,+RCI,0))
137 S PRCA("STATUS")=$P(RCI,U,3),RCCA=$P(RCI,U,4),RCDT=DT
138 S RCAMT=0,RCI=$G(^PRCA(430,PRCABN,7))
139 F X=1:1:5 S RCAMT=RCAMT+$P(RCI,U,X)
140 S RCPB=$P(RCI,U,1),RCIB=$P(RCI,U,2),RCAD=$P(RCI,U,3),RCMF=$P(RCI,U,4),RCCC=$P(RCI,U,5)
141 I RCTR=35 S RCAMT=-RCAMT
142 S DA=PRCAEN,DIE="^PRCA(433,",DR="[PRCAC RC TRAN]" D ^DIE
143 S RCCOM=RCTYP_" Transaction created electronically by local Regional Counsel Office"
144 D COM(PRCAEN,RCCOM)
145 S DA=PRCAEN,DR="7///^S X=""RC""",DIE="^PRCA(433," D ^DIE
146 ;
147 ;If action is not a Returned by RC/DOJ
148 I RCTR'=6 D
149 .S RCI=$P($G(^PRCA(430,PRCABN,6)),U,5)
150 .I RCI="DC" S $P(^PRCA(430,PRCABN,6),U,5)="RC"
151 .D UPSTATS^PRCAUT2
152 .S PRCAA2=$G(^PRCA(433,PRCAEN,4,0))
153 .I $P(PRCAA2,U,4) D
154 ..S PRCAA2=$P(PRCAA2,U,3)
155 ..S $P(^PRCA(433,PRCAEN,4,PRCAA2,0),U,2,5)=RCAMT_"^^1^"_RCAMT
156 ;
157 ;If action is a Decrease
158 I RCTR=35 D G TRANQ
159 .S DA=PRCABN,DIE="^PRCA(430,"
160 .S DR="71///^S X=0;72///^S X=0;73///^S X=0;74///^S X=0;75///^S X=0" D ^DIE
161 .S PRCAQNM=1 D EN1^PRCADJ
162 .S DA=PRCAEN,DIE="^PRCA(433,",DR="14////^S X="_+PRCAQNM
163 .I RCCA S DR=DR_";88////1"
164 .D ^DIE
165 .I RCCA=1 D
166 ..S RCO=$P(^PRCA(430,PRCABN,0),U,3),RCAMT=RCO+RCAMT
167 ..D BULL^IBCNSBL2(PRCABN,RCO,$$PAID^PRCAFN1(+PRCABN))
168 .I '$$ACCK^PRCAACC(PRCABN),'($P($G(^PRCA(433,+PRCAEN,8)),U,8)) D
169 ..D EN^PRCAFBDM(PRCABN,RCAMT,RCTR,RCDT,PRCAEN,.RCERR)
170 .L -^PRCA(430,PRCABN)
171 ;
172 ;If action is a Returned by RC/DOJ
173RT I RCTR=6 D G TRANQ
174 .S DA=PRCABN,DIE="^PRCA(430,"
175 .S DR="64///@;65///@;66///@;68.3///^S X="_RCDT D ^DIE
176 .S DA=PRCAEN,DIE="^PRCA(433,",DR="81///^S X="_RCAMT D ^DIE
177 .L -^PRCA(430,PRCABN)
178 .S XMDUZ="ACCOUNTS RECEIVABLE RC SERVER",XMSUB="AR/RC - REFERRED AR BILL RETURNED BY RC"
179 .S XMY("G.RC RC REFERRALS")=""
180 .S LN(1)=" Referred TP Bill "_$P(^PRCA(430,PRCABN,0),U,1)_" was returned"
181 .S LN(2)=" by Regional Counsel. Return MAY be because"
182 .S LN(3)=" of a reconciliation issue."
183 .S XMTEXT="LN(" D ^XMD
184 ;
185 ;If action is Termination by RC/DOJ
186 I RCTR=29 D G TRANQ
187 .S DA=PRCAEN,DIE="^PRCA(433,",DR="17///9;81///^S X="_RCAMT D ^DIE
188 .I '$$ACCK^PRCAACC(PRCABN) D FMSDOC^RCWROFF(PRCAEN)
189 .L -^PRCA(430,PRCABN)
190 ;
191TRANQ Q
192 ;RCRCRT
Note: See TracBrowser for help on using the repository browser.