source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCRCREC2.m@ 703

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

initial load of WorldVistAEHR
File size: 4.2 KB
Line 
1RCRCREC2 ;ALB/CMS - RC AND DHCP RECONCILIATION REP LOOP ; 16-JUN-00
2V ;;4.5;Accounts Receivable;**61,82,63,147,159**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;Called from RCRCREC to loop through the XTMP(RCXTYP) global
6 ;and the ^PRCA(430,"AD" cross-ref and compare the two. The
7 ;task execution time is set by the RC RC SERV menu option Server
8 ;Action. This job may be killed by IRM but notify the MCCR Referral Cord
9 ;
10 ;INPUT : RCJOB,RCXTYP,RCVAR,RCSITE,RCXMY
11 ;OUTPUT: ^TMP("PRCA",$J,MESSAGE TYPE for each message type
12 ;
13 D ARLOOP
14 D RCLOOP
15END Q
16 ;
17ARLOOP ;LOOP THROUGH AR CROSS-REF DATE "AD" OF 430
18 N RCBN,RCBN0,RCCAT,REF,RFDT
19 S RCCAT="" D RCCAT^RCRCUTL(.RCCAT)
20 S RFDT=0 F S RFDT=$O(^PRCA(430,"AD",RFDT)) Q:'RFDT D RCBN
21 Q
22RCBN ;GET BN AND CHK FOR BAD CROSS-REF, IF TP SET
23 N RCS1,RCS2,RCS3
24 S RCBN=0 F S RCBN=$O(^PRCA(430,"AD",RFDT,RCBN)) Q:'RCBN D
25 .S REF=$P($G(^PRCA(430,RCBN,6)),U,4,6)
26 .I REF="" K ^PRCA(430,"AD",RFDT,RCBN) Q
27 .I $P(REF,U,1)="",$P(REF,U,3)="" K ^PRCA(430,"AD",RFDT,RCBN) Q
28 .I $P(REF,U,1)="",$P(REF,U,3)]"" S $P(^PRCA(430,RCBN,6),U,4)=RFDT S $P(REF,U,1)=RFDT
29 .I $P(REF,U,1)'=RFDT S ^PRCA(430,"AD",$P(REF,U,1),RCBN)="" K ^PRCA(430,"AD",RFDT,RCBN)
30 .S RCBN0=$G(^PRCA(430,RCBN,0))
31 .I $P(RCBN0,U,8)'=16 Q
32 .I RCXTYP="PRCADR1",+$P(RCBN0,U,2)'=9 Q
33 .S RCS1=$G(RCCAT(+$P(RCBN0,U,2))) I RCS1="" Q
34 .I $O(RCDIV(0)),('$D(RCDIV("RCDOMAIN",RCDOMNM,$$DIV^IBJDF2(RCBN0)))) Q
35 .S RCS2=$$NAM^RCFN01(+$P(RCBN0,U,9))
36 .;
37 .S RCS3=$P($G(^DPT(+$P(RCBN0,U,7),0)),U,1)
38 .;
39 .;
40 .S ^TMP("PRCA",$J,$P(RCBN0,U,1),RCBN)=$P(RCBN0,U,1)_U_RCS2_U_$P(REF,U,1)_U_$P(REF,U,2)_U_RCS3_U_$P(REF,U,3)_U_$P($G(^DPT(+$P(RCBN0,U,7),0)),U,9)_U_$P(RCS1,U,2)
41 Q
42 ;
43 ;
44RCLOOP ;LOOP THRU THE XTMP GLOBAL SET FROM RC
45 ;MR1- Bill referred by medical Center, but not in Regional Counsel
46 ;MR2- Regional Counsel has bill but, Medical does not show bill as referred
47 ;MR3- Bill in both RC and VAMC but, dollar amount does not agree
48 ;MR4- Bill in both RC and VAMC but, a contract/decrease adjustment was made before referred
49 ;
50 N ERR,I,RCI,RCLN
51 S RCI=0 F S RCI=$O(^XTMP(RCXTYP,RCXMZ,RCI)) Q:'RCI D
52 .S RCLN=^XTMP(RCXTYP,RCXMZ,RCI) K ERR
53 .I RCLN["$$RC$" Q
54 .I RCLN'["^" Q
55 .I $P(RCLN,U,1)="" D MR2 Q
56 .I $D(^TMP("PRCA",$J,$P(RCLN,U,1))) D MR34 Q
57 .I '$D(^TMP("PRCA",$J,$P(RCLN,U,1))) D MR2
58 D MR1
59 D SORT^RCRCREC3
60 Q
61 ;
62MR34 ;BILL IS IN BOTH SYSTEMS AS REFERRED
63 ;MR3. SEE IF DOLLAR AMT IS THE SAME
64 ;MR4. SEE IF DECREASE/CONTRACT DONE BEFORE REFERRED
65 N ARLN,ARBAL,BN,CURBAL,MTYP,X S MTYP="MR3" K ERR
66 S BN=$O(^TMP("PRCA",$J,$P(RCLN,U,1),0)) G MR34Q:BN=""
67 S ARLN=^TMP("PRCA",$J,$P(RCLN,U,1),BN)
68 I +$P(ARLN,U,6)'=$P(+$P(RCLN,U,6),".00",1) S ERR("MR3",3)=""
69 S ARBAL=$G(^PRCA(430,BN,7)),CURBAL=0
70 I ARBAL]"" F X=1:1:5 S CURBAL=CURBAL+$P(ARBAL,U,X)
71 I +CURBAL'=+$P(ARLN,U,6) S ERR("MR3",7)=CURBAL
72 I $P(RCLN,U,7)]"",$P(ARLN,U,7)'=$P(RCLN,U,7) S ERR("MR3",9)=""
73 I $O(ERR("MR3",0)) S MTYP="MR3" G MR34A
74 S MTYP="MR4" D L433^RCRCREC3 I $O(ERR("MR4",0)) S RCLN=""
75 I '$O(ERR("MR4",0)) G MR34B
76MR34A K ERR("MR3",3) D SET^RCRCREC3
77MR34B K ^TMP("PRCA",$J,$P(ARLN,U,1)),^XTMP(RCXTYP,RCXMZ,RCI)
78MR34Q Q
79 ;
80MR2 ;MR2 BILL IS AT RC AS REFERRED BUT NOT IN AR AS REFERRED
81 N BN,MTYP,REFDT,RCBN0,RFDT S MTYP="MR2"
82 I $P(RCLN,U,1)="" S ERR("MR2",1)="" G MR2A
83 I '$D(^PRCA(430,"B",$P(RCLN,U,1))) S ERR("MR2",1)="" G MR2A
84 S BN=$O(^PRCA(430,"B",$P(RCLN,U,1),0)) S RCBN0=^PRCA(430,BN,0)
85 I $P(RCBN0,U,8)'=16 S ERR("MR2",2)=$P($G(^PRCA(430.3,+$P(RCBN0,U,8),0)),"^",1) G MR2A
86 I RCXTYP="PRCADR1",$P(RCBN0,U,2)'=9 S ERR("MR2",6)=$P($G(^PRCA(430.2,+$P(RCBN0,U,2),0)),"^",1) G MR2A
87 ;I '$G(RCCAT(+$P(RCBN0,U,2))) S ERR("MR2",6)=$P($G(^PRCA(430.2,+$P(RCBN0,U,2),0)),U,1) G MR2A
88 S RFDT=$P($G(^PRCA(430,BN,6)),U,4) I RFDT="" S ERR("MR2",5)="" G MR2A
89 I '$D(^PRCA(430,"AD",RFDT,BN)) S ^PRCA(430,"AD",RFDT,BN)="" G MR2B
90 G MR2B
91MR2A D SET^RCRCREC3
92MR2B K ^XTMP(RCXTYP,RCXMZ,RCI)
93MR2Q Q
94 ;
95MR1 ;BILLS REFERRED IN AR NOT IN RC
96 N ARBAL,BN,CURBAL,ERR,I,MTYP,RCBNAM,REFDT,X
97 S RCLN="",RCI="",MTYP="MR1"
98 S RCBNAM="" F I=1:1 S RCBNAM=$O(^TMP("PRCA",$J,RCBNAM)) Q:'RCBNAM D
99 .S BN=$O(^TMP("PRCA",$J,RCBNAM,0))
100 .I $O(RCDIV(0)),('$D(RCDIV("RCDOMAIN",RCDOMNM,$$DIV^IBJDF2(+BN)))) Q
101 .S ARLN=^TMP("PRCA",$J,RCBNAM,BN)
102MR1A .D SET^RCRCREC3
103 .K ^TMP("PRCA",$J,RCBNAM)
104MR1Q Q
105 ;
106 ;
107 ;
108 ;
109 ;RCRCREC2
Note: See TracBrowser for help on using the repository browser.