81 lines
3.6 KiB
Mathematica
81 lines
3.6 KiB
Mathematica
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
|
|
;
|