RCDPURED ;WISC/RFJ-file 344 receipt/payment dd calls ;1 Jun 99
 ;;4.5;Accounts Receivable;**114,169,174,196,202,244**;Mar 20, 1995
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
 Q
 ;
 ;
 ;  ***** dd references from file 344 (receipts) *****
 ;
 ;
DUPLCATE ;  called by input transform receipt number (.01)
 ;  make sure no duplicate receipt numbers
 I $O(^RCY(344,"B",X,"")) K X W !,"This is a duplicate receipt number." Q
 I $O(^PRCA(433,"AF",X,"")) K X W !,"This receipt number has already been used and has been purged from the system. " K X
 Q
 ;
 ;
PAYCOUNT(RCRECTDA) ;  called by computed field number of transactions (101)
 ;  return the count of payments for the receipt
 N COUNT,X
 S COUNT=0
 S X=0 F  S X=$O(^RCY(344,+$G(RCRECTDA),1,X)) Q:'X  S COUNT=COUNT+1
 Q COUNT
 ;
 ;
PAYTOTAL(RCRECTDA) ;  called by computed field total amount of receipts (.15)
 ;  return the total dollars for payments entered for the receipt
 N TOTAL,X
 S TOTAL=0
 S X=0 F  S X=$O(^RCY(344,+$G(RCRECTDA),1,X)) Q:'X  S TOTAL=TOTAL+$P($G(^(X,0)),"^",4)
 Q TOTAL
 ;
 ;
 ;  ***** dd references from sub-file 344.01 (transactions) *****
 ;
 ;
CHGAMT ;  called from the input transform on the transaction amount (.04)
 ;  field.  if the amount is changed, this will create a new cancelled
 ;  transaction showing the original amount before the change.
 N ORIGDATA,TRANDA
 S ORIGDATA=^RCY(344,DA(1),1,DA,0)
 ;  no original payment amount
 I '$P(ORIGDATA,"^",4) Q
 ;  payment amount did not change
 I +$P(ORIGDATA,"^",4)=+X Q
 ;  payment amount increased
 I $P(ORIGDATA,"^",4)<X Q
 ;  amount was changed
 ;  enter a new transaction
 S TRANDA=$$ADDTRAN^RCDPURET(DA(1))
 I 'TRANDA W !,"  Unable to edit amount." K X Q
 ;  copy the current data for the transaction
 ;  do not use fileman, will overwrite variables
 ;  set the cancel comment (field 1.01)
 S $P(^RCY(344,DA(1),1,TRANDA,1),"^")="Amount $"_$P(ORIGDATA,"^",4)_" decreased in original trans#"_DA
 ;  set the payment amount to zero (for cancelled)
 S $P(ORIGDATA,"^",4)=0
 S $P(ORIGDATA,"^",14)=DUZ
 S $P(^RCY(344,DA(1),1,TRANDA,0),"^",2,99)=$P(ORIGDATA,"^",2,99)
 Q
 ;
 ;
PAYCHK ;  called from the input transform on the transaction amount (.04)
 ;  field.  This will compare the amount paid with the amount owed
 ;  for a bill.
 N ACCOUNT,AMOUNT,OWED
 S ACCOUNT=$P($G(^RCY(344,DA(1),1,DA,0)),"^",3)
 ;  quit, account not a bill
 I ACCOUNT'["PRCA(430," Q
 ;  quit, account is a patient
 I $P($G(^RCD(340,+$P($G(^PRCA(430,+ACCOUNT,0)),"^",9),0)),"^")[";DPT(" Q
 ;  calculate amount owed for a bill
 S OWED=$G(^PRCA(430,+ACCOUNT,7))
 S OWED=$P(OWED,"^")+$P(OWED,"^",2)+$P(OWED,"^",3)+$P(OWED,"^",4)+$P(OWED,"^",5)
 ;  compare amount paid (in x) with amount owed (if not processed 0;7)
 I X>OWED,'$P($G(^RCY(344,DA(1),0)),"^",7) W "  WARNING: Payment amount greater than amount of bill!"
 ;  check for other bills
 S AMOUNT=$$EOB^IBCNSBL2(+ACCOUNT,+$P($G(^PRCA(430,+ACCOUNT,0)),"^",3),$$PAID^PRCAFN1(+ACCOUNT))
 I AMOUNT W !!,$P(AMOUNT,"^",2)," may also be billable.",!
 Q
 ;
 ;
PNORBILL ;  called by the input transform in receipt file 344, transaction
 ;  multiple (field 1), patient name or bill number (sub field .09)
 I $L(X)>20!($L(X)<1) K X Q
 ;
 N DFN,RCBILL,RCINPUT,RCOUTPUT,Y,RCTYP,DIC
 ;
 S RCINPUT=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
 ;  try and lookup on bill number
 S X=$S($O(^PRCA(430,"B",RCINPUT,0)):$O(^(0))_";PRCA(430,",$O(^PRCA(430,"D",RCINPUT,0)):$O(^(0))_";PRCA(430,",1:RCINPUT)
 I X[";PRCA(430," D DISPLAY(X)
 ;  bill not found, try and lookup on patient
 I X=RCINPUT S DIC="^DPT(",DIC(0)="EM" D ^DIC S X=+Y_";DPT("
 ;  new value in variable X (output in X)
 ;
 ;  patient not found, type of payment = check/mo
 I +$G(Y)<0,($P($G(^RCY(344,DA(1),0)),"^",4)=4) D
 .   S (X,Y)=$$REC^IBRFN(RCINPUT,.RCTYP),(RCBILL,X)=X_";PRCA(430,"
 .   I Y>0 D
 .   .   N DIR,DIQ2,DIRUT,DTOUT,DUOUT,RCPRM
 .   .   S RCTYP=$G(RCTYP,1)
 .   .   S RCPRM=$S(RCTYP=1:"TRICARE reference number",RCTYP=2:"ECME Rx reference number",RCTYP=3:"prescription number",1:"reference number")
 .   .   S DIR("A")="Is this "_RCPRM_" - "_RCINPUT
 .   .   S DIR("B")="No",DIR("A",1)=" "
 .   .   S DIR(0)="Y^O" D ^DIR S:'Y Y=-1
 .   .   I Y'>0 Q
 .   .   W !!,$P($G(^PRCA(430,+RCBILL,0)),"^")," "
 .   .   D DISPLAY(RCBILL)
 .   .   S X=RCBILL
 ;  output in variable X
 ;
 I +$G(Y)<0 K X Q
 ;
 S RCOUTPUT=X
 ;
 ;  patient account, show messages and quit (output still in variable X)
 I RCOUTPUT[";DPT(" D CHECKPAT(+RCOUTPUT) Q
 ;
 ;  bill account
 I $$IB^IBRUTL(+RCOUTPUT) W " ... This bill appears to have other patient bills on 'hold'."
 S X=$P($G(^RCD(340,+$P(^PRCA(430,+RCOUTPUT,0),"^",9),0)),"^")
 I X[";DPT(" D CHECKPAT(+X)
 S X=RCOUTPUT
 Q
 ;
 ;
CHECKPAT(DFN) ;  check patient for other charges, etc., show message
 N X
 S X="IBARXEU" X ^%ZOSF("TEST")
 I $T S X=$$RXST^IBARXEU(DFN,DT) I X D
 .   W !?2,"* Patient is exempt from RX Copay: ",$P(X,"^",4)," *"
 S X="PSOCOPAY" X ^%ZOSF("TEST")
 I $T S X=$$POT^PSOCOPAY(DFN) I X D
 .   W !?2,"* This patient has ",X,"-30 day RX's totaling $",(X*8),".00 that are potentially *"
 .   W !?2,"* billable.  This represents any Window Rx's issued today. *"
 Q
 ;
 ;
DISPLAY(RCBILLDA) ;  display bill
 N DATA
 S DATA=$P(^PRCA(430,+RCBILLDA,0),"^",9) W:DATA "  ",$$NAM^RCFN01(DATA)
 S DATA=$P(^PRCA(430,+RCBILLDA,0),"^",8) I DATA D
 .   W "   ",$P(^PRCA(430.3,DATA,0),"^")
 .   I $P(^PRCA(430.3,DATA,0),"^",3)'=102,$P($G(^RCD(340,+$P(^PRCA(430,+RCBILLDA,0),"^",9),0)),"^")'[";DPT(" W !,"This bill is not in 'active' status."
 S DATA=$G(^PRCA(430,+RCBILLDA,7)) W "   $",$J($P(DATA,"^")+$P(DATA,"^",2)+$P(DATA,"^",3)+$P(DATA,"^",4)+$P(DATA,"^",5),1,2)
 Q
 ;
 ;
PAYDATE ;  called by the input transform in receipt file 344, transaction
 ;  multiple (field 1), date of payment (sub field .06)
 ;  date of payment not in future or more than one month ago
 N DAYSDIFF
 S DAYSDIFF=$$FMDIFF^XLFDT(X,DT)
 I DAYSDIFF<-31!(DAYSDIFF>0) K X
 Q
 ;
 ;
 ;  ***** dd references from file 344.1 (deposits) *****
 ;
 ;
RECTOTAL(RCDEPTDA) ;  called from computed field TOTAL AMT OF RECEIPTS (.18) in
 ;  deposit file (344.1)
 ;  this returns the total dollars paid for all receipts on deposit ticket
 N RCRECTDA,TOTAL
 S TOTAL=0
 S RCRECTDA=0 F  S RCRECTDA=$O(^RCY(344,"AD",+RCDEPTDA,RCRECTDA)) Q:'RCRECTDA  D
 .   S TOTAL=TOTAL+$$PAYTOTAL(RCRECTDA)
 Q TOTAL
 ;
 ;
RECCOUNT(RCDEPTDA) ;  called from computed field TOTAL RECEIPTS (100) in deposit file (344.1)
 ;  this returns a count of the number of receipts on a deposit ticket
 N RCRECTDA,COUNT
 S COUNT=0
 S RCRECTDA=0 F  S RCRECTDA=$O(^RCY(344,"AD",+RCDEPTDA,RCRECTDA)) Q:'RCRECTDA  D
 .   S COUNT=COUNT+1
 Q COUNT