source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCXVDC1.m@ 897

RCXVDC1 ;DAOU/ALA-AR Data Extraction Data Creation ;02-JUL-03
 ;;4.5;Accounts Receivable;**201,227,228**;Mar 20, 1995
 ;
 Q
EN ; Entry Point
 K ^TMP($J)
D430 ; Get #430 data given RCXVBLN 
 N RCXVD,RCXVD1,RCXVD2,RCXVD3,RCXVD4,RCXVD5,RCXVP1,RCXVP2
 N RCXVDA,RCXVDB,RCXVDC,RCXVVP1,RCXVVP,RCXVX,RCXVY
 S RCXVD1=$G(^PRCA(430,RCXVBLN,0))
 S RCXVD2=$G(^PRCA(430,RCXVBLN,6))
 S RCXVD3=$G(^PRCA(430,RCXVBLN,7))
 S RCXVD4=$G(^PRCA(430,RCXVBLN,11))
 S RCXVD5=$G(^PRCA(430,RCXVBLN,13))
 S RCXVBLNA=$P(RCXVD1,U,1)
 S RCXVBLNB=$P(RCXVBLNA,"-",1)_"-"
 S RCXVDA=RCXVBLNA ; Bill #
 S RCXVP1=$P(RCXVD1,U,2),RCXVP2=""
 I RCXVP1'="" S RCXVP2=$P($G(^PRCA(430.2,RCXVP1,0)),U,1)
 S RCXVDA=RCXVDA_RCXVU_RCXVP2 ; Cat (P)
 S RCXVDA=RCXVDA_RCXVU_$P(RCXVD1,U,3) ; Orig Amt
 S RCXVDA=RCXVDA_RCXVU_$P(RCXVD1,U,4) ; GL #
 S RCXVP1=$P(RCXVD1,U,8),RCXVP2=""
 I RCXVP1'="" S RCXVP2=$P($G(^PRCA(430.3,RCXVP1,0)),U,1)
 S RCXVDA=RCXVDA_RCXVU_RCXVP2 ; Cur Stat (P)
 S RCXVDBN=$$GET1^DIQ(430,RCXVBLN_",",9,"I")
 I RCXVDBN'="" S RCXVDBN=$P($G(^RCD(340,RCXVDBN,0)),U,1) I RCXVDBN="" D
 . NEW CT
 . S CT=$G(^TMP("RCXVBREC",$J,0))+1,^TMP("RCXVBREC",$J,0)=CT
 . S ^TMP("RCXVBREC",$J,CT,0)="Bill # "_$P(^PRCA(430,RCXVBLN,0),"^",1)_" has a bad debtor record."
 I RCXVDBN["DPT",DFN="" S DFN=$P(RCXVDBN,";",1)
 S RCXVVP1=$S(RCXVDBN["DPT":"PATIENT",1:$$GET1^DIQ(430,RCXVBLN_",",9,"E"))
 S RCXVDA=RCXVDA_RCXVU_RCXVVP1 ; Debtor (P)
 S RCXVDT=$P(RCXVD1,U,10)
 S RCXVDA=RCXVDA_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ; DT Bill Preprd 
 S RCXVY(430,11,1)=$G(^PRCA(430,RCXVBLN,7)) ; Cur Bal - Comp
 S RCXVX=$P(RCXVY(430,11,1),U,1)+$P(RCXVY(430,11,1),U,2)+$P(RCXVY(430,11,1),U,3)+$P(RCXVY(430,11,1),U,4)+$P(RCXVY(430,11,1),U,5) S RCXVX=$J(RCXVX,0,2)
 S RCXVDA=RCXVDA_RCXVU_RCXVX ;  Cur. Bal. - computed
 S RCXVDT=$P(RCXVD1,U,14)
 S RCXVDA=RCXVDA_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ; DT Stat Upd
 S RCXVDT=$P($P(RCXVD2,U,21),".",1)
 S RCXVDB=$$HLDATE^HLFNC(RCXVDT) ; DT acct actd
 S RCXVDT=$P(RCXVD2,U,1)
 S RCXVDB=RCXVDB_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ; Letter 1 (DT)
 S RCXVDT=$P(RCXVD2,U,4)
 S RCXVDB=RCXVDB_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ; Ref DT
 S RCXVDB=RCXVDB_RCXVU_$P(RCXVD2,U,5) ; RF code
 S RCXVDB=RCXVDB_RCXVU_$P(RCXVD2,U,6) ; RF amt
 S RCXVDT=$P(RCXVD2,U,10)
 S RCXVDB=RCXVDB_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ; RF DT
 S RCXVDT=$P(RCXVD2,U,11)
 S RCXVDB=RCXVDB_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ; Rtrn DT
 S RCXVDT=$P(RCXVD2,U,12)
 S RCXVDB=RCXVDB_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ; RF DT to COWC
 S RCXVDB=RCXVDB_RCXVU_$P(RCXVD2,U,13) ; RF amt to COWC
 S RCXVDB=RCXVDB_RCXVU_$P(RCXVD4,U,23) ; RSC
 S RCXVDB=RCXVDB_RCXVU_$P(RCXVD3,U,1) ; PRIN BAL
 S RCXVDC=$P(RCXVD3,U,2) ; INT BAL
 S RCXVDC=RCXVDC_RCXVU_$P(RCXVD3,U,3) ; ADMIN COST BAL
 S RCXVDC=RCXVDC_RCXVU_$P(RCXVD3,U,7) ; TOT PAID PRINC
 S RCXVDC=RCXVDC_RCXVU_$P(RCXVD3,U,8) ; TOT PAID INT
 S RCXVDC=RCXVDC_RCXVU_$P(RCXVD3,U,9) ; TOT PAID ADMIN
 S RCXVDC=RCXVDC_RCXVU_$P(RCXVD3,U,10) ; TOT PAID MARSHAL FEE
 S RCXVDC=RCXVDC_RCXVU_$P(RCXVD4,U,17) ;  FUND
 S RCXVP1=$P(RCXVD4,U,6),RCXVP2=""
 I RCXVP1'="" S RCXVP2=$P($G(^RC(347.3,RCXVP1,0)),U,1)
 S RCXVDC=RCXVDC_RCXVU_RCXVP2 ; REV SRCE (P)
 S RCXVDT=$$DFP^RCXVUTIL(RCXVBLN)
 S RCXVDC=RCXVDC_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ; DT 1ST PAYMNT
 S RCXVDC=RCXVDC_RCXVU_$P(RCXVD5,U)  ;MEDICARE CONTRACT ADJUSTMENT AMT
 S RCXVDC=RCXVDC_RCXVU_$P(RCXVD5,U,2) ;MEDICARE UNREIMBURSABLE AMOUNT
 S RCXVDC=RCXVDC_RCXVU_$P(RCXVD3,U,18) ;REFUNDED AMOUNT
 S RCXVDT=$P(RCXVD3,U,19)
 S RCXVDC=RCXVDC_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ;REFUNDED DATE
 ; 
 S ^TMP($J,RCXVBLN,"1-430A")=RCXVDA
 S ^TMP($J,RCXVBLN,"1-430B")=RCXVDB
 S ^TMP($J,RCXVBLN,"1-430C")=RCXVDC
 Q
 ;