| 1 | PRCAX ;WASH-ISC@ALTOONA,PA/TJK-MEDICATION COPAY EXEMPTION ;7/20/93 1:09 PM
|
|---|
| 2 | V ;;4.5;Accounts Receivable;**68**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | EN1(DFN,BEG,END,ERR) ;ENTRY POINT FROM IB
|
|---|
| 5 | I 'DFN!($G(^DPT(DFN,0))="") S ERR="INVALID PATIENT DFN" Q
|
|---|
| 6 | I '$O(^RCD(340,"B",DFN_";DPT(",0)) S ERR="NO PATIENT ACCOUNT" Q
|
|---|
| 7 | I 'BEG S ERR="NO BEGINNING DATE" Q
|
|---|
| 8 | I BEG>DT S ERR="BEGINNING DATE IS IN FUTURE" Q
|
|---|
| 9 | I BEG'?7N S ERR="BEGINNING DATE IN IMPROPER FORMAT" Q
|
|---|
| 10 | I END,END'?7N S ERR="ENDING DATE IN IMPROPER FORMAT" Q
|
|---|
| 11 | I END,BEG>END S ERR="BEGINNING DATE GREATER THAN ENDING DATE" Q
|
|---|
| 12 | S:'END END=9999999
|
|---|
| 13 | K ^TMP($J)
|
|---|
| 14 | N ACCT,BILL,BUCKET,B0,DATE,NEWBAL,OLDBAL,PREPAY,TRAN,TDATE,T0,T1,TRAMT,X,TTYPE,DURING,STATUS,BN7,DECAMT,EXTOT,I,PRCAEN,DIC,DIE,DA,DR,MSG,PERROR,NBILL,NTRAN,MSGCNTS
|
|---|
| 15 | S PREPAY=$O(^PRCA(430.2,"B","PREPAYMENT",0))
|
|---|
| 16 | S ACCT=$O(^RCD(340,"B",DFN_";DPT(",0))
|
|---|
| 17 | S (BILL,BUCKET)=0
|
|---|
| 18 | F S BILL=$O(^PRCA(430,"C",ACCT,BILL)) Q:'BILL S B0=$G(^PRCA(430,BILL,0)) I $S($P(B0,U,2)=22:1,$P(B0,U,2)=23:1,1:0) D PROC
|
|---|
| 19 | I $O(^TMP($J,0)),BUCKET S BILL=0 F S BILL=$O(^TMP($J,BILL)) Q:'BILL Q:'BUCKET S OLDBAL=^(BILL) D APPLY
|
|---|
| 20 | D REFUND:BUCKET
|
|---|
| 21 | S ERR=$G(PERROR) K ^TMP($J) Q
|
|---|
| 22 | PROC ;PROCESS BILLS
|
|---|
| 23 | S DATE=$P(B0,U,10),(OLDBAL,NEWBAL)=$P(B0,U,3),STATUS=$P(B0,U,8)
|
|---|
| 24 | I DATE'<BEG,DATE'>END S NEWBAL=0
|
|---|
| 25 | S TRAN=0 F S TRAN=$O(^PRCA(433,"C",BILL,TRAN)) Q:'TRAN S T0=$G(^PRCA(433,TRAN,0)),T1=$G(^(1)),TDATE=+T1,TTYPE=$P(T1,U,2),TRAMT=$P(T1,U,5) I $P(T0,U,4)=2,TDATE,TTYPE,TRAMT D CNT
|
|---|
| 26 | ;SET BUCKET HERE
|
|---|
| 27 | I NEWBAL'=OLDBAL S BUCKET=BUCKET+$S(OLDBAL:OLDBAL-NEWBAL,NEWBAL<0:-NEWBAL,1:NEWBAL),^TMP($J,"BUCKET",BILL)=$S(OLDBAL:OLDBAL-NEWBAL,NEWBAL<0:-NEWBAL,1:NEWBAL)
|
|---|
| 28 | K TRAMT
|
|---|
| 29 | I OLDBAL,",16,42,"[(","_STATUS_",") D:BUCKET APPLY S:OLDBAL ^TMP($J,BILL)=OLDBAL
|
|---|
| 30 | Q
|
|---|
| 31 | CNT ;PROCESS TRANSACTIONS
|
|---|
| 32 | S:(TTYPE'=12)&(TRAMT<0) TRAMT=-TRAMT
|
|---|
| 33 | S DURING=0 I TDATE'<BEG,TDATE'>END S DURING=1
|
|---|
| 34 | I ",1,12,13,24,43,"[(","_TTYPE_",") S OLDBAL=OLDBAL+TRAMT S:'DURING NEWBAL=NEWBAL+TRAMT Q
|
|---|
| 35 | I "^2^34^"[("^"_TTYPE_"^") S OLDBAL=OLDBAL-TRAMT,NEWBAL=NEWBAL-TRAMT Q
|
|---|
| 36 | I ",8,9,10,11,14,29,35,"[(","_TTYPE_",") S OLDBAL=OLDBAL-TRAMT D
|
|---|
| 37 | .I NEWBAL<0 Q
|
|---|
| 38 | .I NEWBAL-TRAMT<0 S NEWBAL=0 Q
|
|---|
| 39 | .S NEWBAL=NEWBAL-TRAMT
|
|---|
| 40 | .Q
|
|---|
| 41 | Q
|
|---|
| 42 | APPLY ;APPLY OUTSTANDING DECREASES TO ACTIVE OR OPEN CO-PAY BILLS
|
|---|
| 43 | S EXTOT=0,BN7=$G(^PRCA(430,BILL,7)) F I=2:1:5 S EXTOT=EXTOT+$P(BN7,U,I)
|
|---|
| 44 | G DEC:'EXTOT S TRAMT=0 S:EXTOT'<BUCKET EXTOT=BUCKET
|
|---|
| 45 | INT F I=5:-1:2 Q:'EXTOT I $P(BN7,U,I) S X=$P(BN7,U,I),DECAMT=$S(X>BUCKET:BUCKET,1:X),$P(BN7,U,I)=$P(BN7,U,I)-DECAMT,BUCKET=BUCKET-DECAMT,EXTOT=EXTOT-DECAMT,TRAMT=TRAMT+DECAMT
|
|---|
| 46 | S OLDBAL=OLDBAL-TRAMT
|
|---|
| 47 | ;SET EXEMPTION TRANSACTION HERE
|
|---|
| 48 | D SETTR^PRCAUTL
|
|---|
| 49 | S TTYPE=14,DIE="^PRCA(433,",DA=PRCAEN,MSG="INTEREST/ADMIN EXEMPTION APPLIED DUE TO CO-PAY EXEMPTION"
|
|---|
| 50 | S DR=".03////"_BILL_";11////"_DT_";12////"_TTYPE_";15////"_TRAMT_";41////"_MSG_";89////1;4////2"
|
|---|
| 51 | S DIC=DIE D ^DIE,AUDIT^PRCAX1
|
|---|
| 52 | K DA,DIC,DIE,DR,TRAMT
|
|---|
| 53 | S $P(^PRCA(430,BILL,7),U,2,5)=$P(BN7,U,2)_U_$P(BN7,U,3)_U_$P(BN7,U,4)_U_$P(BN7,U,5)
|
|---|
| 54 | I 'OLDBAL S STATUS=39,NBILL=BILL D UPDTST Q
|
|---|
| 55 | Q:'BUCKET
|
|---|
| 56 | DEC ;SET DECREASE TRANSACTION HERE
|
|---|
| 57 | S PRCAEN=0,DECAMT=BUCKET D DEC^PRCASER1(BILL,.DECAMT,DUZ,"DECREASE ADJUSTMENT APPLIED DUE TO CO-PAY EXEMPTION","",.PRCAEN)
|
|---|
| 58 | I $G(PRCAEN) S ^PRCA(433,"ACE",DT,PRCAEN)="",$P(^PRCA(433,PRCAEN,1),U,10)=1,DA=PRCAEN,DIE=433
|
|---|
| 59 | S OLDBAL=OLDBAL-(BUCKET-DECAMT),DECAMT1=BUCKET-DECAMT,BUCKET=DECAMT
|
|---|
| 60 | I $G(PRCAEN) S DECAMT=DECAMT1 D AUDIT^PRCAX1 K DECAMT
|
|---|
| 61 | K DECAMT1 Q
|
|---|
| 62 | REFUND ;SETS UP PREPAYMENT BILL WITH REFUND REVIEW STATUS
|
|---|
| 63 | S PERROR="" D EN^PRCAPAY3(DFN_";DPT(",BUCKET,DT,DUZ,"","","",.PERROR)
|
|---|
| 64 | Q:PERROR]""
|
|---|
| 65 | S NBILL=0 F S NBILL=$O(^PRCA(430,"AS",ACCT,$O(^PRCA(430.3,"AC",112,0)),NBILL)) Q:'NBILL I $P(^PRCA(430,NBILL,0),U,2)=PREPAY Q
|
|---|
| 66 | Q:'NBILL S (TRAN,NTRAN)=0 F S NTRAN=TRAN,TRAN=$O(^PRCA(433,"C",NBILL,NTRAN)) Q:'TRAN
|
|---|
| 67 | I NTRAN S ^PRCA(433,"ACE",DT,NTRAN)="",$P(^PRCA(433,NTRAN,1),U,10)=1
|
|---|
| 68 | S MSG="REFUND DUE TO CO-PAY EXEMPTION",STATUS=44
|
|---|
| 69 | UPDTST ;UPDATES STATUS TO CANCELLED OR REFUND REVIEW
|
|---|
| 70 | S (DIC,DIE)="^PRCA(430,",DA=NBILL,DR="8///"_STATUS
|
|---|
| 71 | I STATUS=44 D RR
|
|---|
| 72 | S:NBILL'=BILL DR=DR_";98///"_MSG
|
|---|
| 73 | D ^DIE K DR,DIC D AUDIT^PRCAX1 Q
|
|---|
| 74 | ;
|
|---|
| 75 | RR ;REFUND REVIEW BILL FIELDS UPDATED
|
|---|
| 76 | K RA F X=1:1:5 S RA=$G(RA)+$P($G(^PRCA(430,NBILL,7)),"^",X)
|
|---|
| 77 | S DR=DR_";79.18////"_RA_";90///@;79.21///@;91///@;111///@;112///@"
|
|---|
| 78 | K RA Q
|
|---|
| 79 | ;
|
|---|
