93 lines
4.2 KiB
Mathematica
93 lines
4.2 KiB
Mathematica
RCRCREC3 ;ALB/CMS - PARSE RC/AR DATA FOR RECONCILIATION
|
|
V ;;4.5;Accounts Receivable;**63,122**;Mar 20, 1995
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;
|
|
Q
|
|
L433 ;LOOP THRU 433 TO SEE IF BILL WAS DECREASE BEFORE REFERRED
|
|
;INPUT: BN,MTYP=4,ARLN RCBDT - RCEDT REFERRAL DATE RANGE
|
|
;QUIT IF BILL REFERRAL DATE NOT IN USER INPUT RANGE
|
|
N TN,TNLN,TNTYP K ERR
|
|
S REFDT=$P(ARLN,U,3)
|
|
I $G(RCBDT)>0,$G(RCEDT)>0 I (REFDT<RCBDT)!(REFDT>RCEDT) G L433Q
|
|
S TN=0 F S TN=$O(^PRCA(433,"C",BN,TN)) Q:('TN)!($O(ERR("MR4",0))) D
|
|
.S TNLN=$G(^PRCA(433,TN,1))
|
|
.I TNLN="" Q
|
|
.S TNTYP=$P(TNLN,U,2) I TNTYP'=35 Q
|
|
.I $P(TNLN,U,1)'>REFDT D
|
|
..I +$P($G(^PRCA(433,TN,8)),U,8) S ERR("MR4",4)="" Q
|
|
..S ERR("MR4",11)=""
|
|
L433Q Q
|
|
;
|
|
SET ;SET TMP WITH THE MESSAGE TYPE PER BILL
|
|
N ERRLN,ERRN,LN,LT,REFDT,X,Y
|
|
N SPBN,SPPT,SPIN S LN=0
|
|
I $G(ARLN)="" G SETB
|
|
S (SPBN,SPPT,SPIN)="",LN=LN+1
|
|
I $P(ARLN,U,1)="" S $P(ARLN,U,1)="UNK"
|
|
I $P(RCLN,U,1)="" S $P(RCLN,U,1)="UNK"
|
|
S Y=$P(ARLN,U,3) D D^DIQ S REFDT=Y
|
|
I $L(REFDT)<10 S $E(REFDT,11)=" "
|
|
I $L(REFDT)=10 S REFDT=REFDT_" "
|
|
S $E(SPBN,(11-$L($E($P(ARLN,U,1),1,11))))=" "
|
|
S $E(SPPT,(15-$L($E($P(ARLN,U,5),1,15))))=" "
|
|
S $E(SPIN,(15-$L($E($P(ARLN,U,2),1,15))))=" "
|
|
;S LN=+^TMP("PRCA",$J,MTYP,0)
|
|
;S LN=LN+1,^TMP("PRCA",$J,MTYP,LN)=" "
|
|
;S LN=LN+1
|
|
S ^TMP("PRCA",$J,"B",MTYP,$S($P($G(ARLN),U,8)]"":$P($G(ARLN),U,8),1:"CAT/UNK"),$S($P(ARLN,U,2)]"":$P(ARLN,U,2),1:"UNK"),$S($P(ARLN,U,5)]"":$P(ARLN,U,5),1:"UNK"),$P(ARLN,U,1))=""
|
|
S ^TMP("PRCA",$J,"C",$P(ARLN,U,1),LN)="AR:"_$P(ARLN,U,1)_$G(SPBN)_" "_$E($P(ARLN,U,5),1,15)_$G(SPPT)_" "_$E($P(ARLN,U,2),1,15)_$G(SPIN)_" "_$S($P(ARLN,U,4)="DC":"RC ",1:$P(ARLN,U,4))_" "_REFDT_" $"_$J($P(ARLN,U,6),10,2)
|
|
;
|
|
SETB I $G(RCLN)="" G SETC
|
|
S (SPBN,SPPT,SPIN)="",LN=LN+1
|
|
S Y=$P(RCLN,U,3) D D^DIQ S REFDT=Y
|
|
I $L(REFDT)<10 S $E(REFDT,11)=" "
|
|
I $L(REFDT)=10 S REFDT=REFDT_" "
|
|
S $E(SPBN,(11-$L($E($P(RCLN,U,1),1,11))))=" "
|
|
S $E(SPPT,(15-$L($E($P(RCLN,U,5),1,15))))=" "
|
|
S $E(SPIN,(15-$L($E($P(RCLN,U,2),1,15))))=" "
|
|
;S LN=+^TMP("PRCA",$J,MTYP,0)
|
|
;S LN=LN+1,^TMP("PRCA",$J,MTYP,LN)=" "
|
|
;S LN=LN+1
|
|
I $G(ARLN)="" D
|
|
.S ^TMP("PRCA",$J,"B",MTYP,$S($P(RCLN,U,8)]"":$P(RCLN,U,8),1:"CAT/UNK"),$S($P(RCLN,U,2)]"":$P(RCLN,U,2),1:"UNK"),$S($P(RCLN,U,5)]"":$P(RCLN,U,5),1:"UNK"),$S($P(RCLN,U,1)]"":$P(RCLN,U),1:"UNK"))=""
|
|
S ^TMP("PRCA",$J,"C",$S($P(RCLN,U,1)]"":$P(RCLN,U),1:"UNK"),LN)="RC:"_$P(RCLN,U,1)_$G(SPBN)_" "_$E($P(RCLN,U,5),1,15)_$G(SPPT)_" "_$E($P(RCLN,U,2),1,15)_$G(SPIN)_" RC "_REFDT_" $"_$J($P(RCLN,U,6),10,2)
|
|
;
|
|
SETC S ERRN=0 F S ERRN=$O(ERR(MTYP,ERRN)) Q:'ERRN D
|
|
.S LT="ARR",ERRLN=$T(@LT+ERRN),LN=LN+1
|
|
.S ^TMP("PRCA",$J,"C",$S($P($G(ARLN),U,1)]"":$P(ARLN,U,1),$P($G(RCLN),U,1)]"":$P(RCLN,U,1),1:"UNK"),LN)=" - "_$P(ERRLN,";",4)_" "_$G(ERR(MTYP,ERRN))
|
|
;S ^TMP("PRCA",$J,MTYP,0)=LN
|
|
SETQ Q
|
|
;
|
|
SORT ;Set Global for Mail Message
|
|
N A,B,C,D,E,LN,RCA,RCB,RCBSP,RCC,RCD,RCE,X,Y
|
|
F X=1:1:19 S RCBSP=$G(RCBSP)_" "
|
|
S RCA="" F A=1:1 S RCA=$O(^TMP("PRCA",$J,"B",RCA)) Q:RCA="" D
|
|
.S LN=^TMP("PRCA",$J,RCA,0)
|
|
.S RCB="" F B=1:1 S RCB=$O(^TMP("PRCA",$J,"B",RCA,RCB)) Q:RCB="" D
|
|
..S LN=LN+1,^TMP("PRCA",$J,RCA,LN)="REIMBURS.HEALTH INS."_RCBSP_"Referred To Date Amount"
|
|
..S LN=LN+1,^TMP("PRCA",$J,RCA,LN)=" "
|
|
..S RCC="" F C=1:1 S RCC=$O(^TMP("PRCA",$J,"B",RCA,RCB,RCC)) Q:RCC="" D
|
|
...S RCD="" F D=1:1 S RCD=$O(^TMP("PRCA",$J,"B",RCA,RCB,RCC,RCD)) Q:RCD="" D
|
|
....S RCE="" F E=1:1 S RCE=$O(^TMP("PRCA",$J,"B",RCA,RCB,RCC,RCD,RCE)) Q:RCE="" D
|
|
.....S LN=LN+1,^TMP("PRCA",$J,RCA,LN)=" "
|
|
.....S X=0 F S X=$O(^TMP("PRCA",$J,"C",RCE,X)) Q:'X D
|
|
......S LN=LN+1,^TMP("PRCA",$J,RCA,LN)=^TMP("PRCA",$J,"C",RCE,X)
|
|
......S ^TMP("PRCA",$J,RCA,0)=LN
|
|
SORTQ Q
|
|
;
|
|
ARR ;GET DATA FOR ERROR TYPES
|
|
;;1;BILL NAME DOES NOT EXIST IN ACCOUNTS RECEIVABLE
|
|
;;2;NON-ACTIVE BILL AT SITE, CURRENT AR BILL STATUS IS
|
|
;;3;DOLLAR AMOUNTS NOT THE SAME
|
|
;;4;CONTRACTUAL/DECREASE ADJUSTMENT WAS MADE IN AR BEFORE REFERRAL DATE
|
|
;;5;NO REFERRAL DATE IN THE AR ACCOUNTS RECEIVABLE FILE
|
|
;;6;AR BILL CATEGORY IS
|
|
;;7;SITE PROBLEM, AR REF.AMT DOES NOT MATCH AR CURRENT BALANCE OF $
|
|
;;8;NOT IN USE
|
|
;;9;BILL SSN FOR PT. IN AR DOES NOT MATCH SSN FOR PT. IN RC
|
|
;;10;NOT IN USE
|
|
;;11;DECREASE ADJUSTMENT WAS MADE IN AR BEFORE THE REFERRAL DATE
|
|
;;END
|
|
Q
|
|
;RCRCREC3
|