| 1 | RCRCREC2 ;ALB/CMS - RC AND DHCP RECONCILIATION REP LOOP ; 16-JUN-00
|
---|
| 2 | V ;;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
|
---|
| 15 | END Q
|
---|
| 16 | ;
|
---|
| 17 | ARLOOP ;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
|
---|
| 22 | RCBN ;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 | ;
|
---|
| 44 | RCLOOP ;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 | ;
|
---|
| 62 | MR34 ;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
|
---|
| 76 | MR34A K ERR("MR3",3) D SET^RCRCREC3
|
---|
| 77 | MR34B K ^TMP("PRCA",$J,$P(ARLN,U,1)),^XTMP(RCXTYP,RCXMZ,RCI)
|
---|
| 78 | MR34Q Q
|
---|
| 79 | ;
|
---|
| 80 | MR2 ;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
|
---|
| 91 | MR2A D SET^RCRCREC3
|
---|
| 92 | MR2B K ^XTMP(RCXTYP,RCXMZ,RCI)
|
---|
| 93 | MR2Q Q
|
---|
| 94 | ;
|
---|
| 95 | MR1 ;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)
|
---|
| 102 | MR1A .D SET^RCRCREC3
|
---|
| 103 | .K ^TMP("PRCA",$J,RCBNAM)
|
---|
| 104 | MR1Q Q
|
---|
| 105 | ;
|
---|
| 106 | ;
|
---|
| 107 | ;
|
---|
| 108 | ;
|
---|
| 109 | ;RCRCREC2
|
---|