source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCXVDC1.m@ 1710

Last change on this file since 1710 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.6 KB
RevLine 
[613]1RCXVDC1 ;DAOU/ALA-AR Data Extraction Data Creation ;02-JUL-03
2 ;;4.5;Accounts Receivable;**201,227,228**;Mar 20, 1995
3 ;
4 Q
5EN ; Entry Point
6 K ^TMP($J)
7D430 ; Get #430 data given RCXVBLN
8 N RCXVD,RCXVD1,RCXVD2,RCXVD3,RCXVD4,RCXVD5,RCXVP1,RCXVP2
9 N RCXVDA,RCXVDB,RCXVDC,RCXVVP1,RCXVVP,RCXVX,RCXVY
10 S RCXVD1=$G(^PRCA(430,RCXVBLN,0))
11 S RCXVD2=$G(^PRCA(430,RCXVBLN,6))
12 S RCXVD3=$G(^PRCA(430,RCXVBLN,7))
13 S RCXVD4=$G(^PRCA(430,RCXVBLN,11))
14 S RCXVD5=$G(^PRCA(430,RCXVBLN,13))
15 S RCXVBLNA=$P(RCXVD1,U,1)
16 S RCXVBLNB=$P(RCXVBLNA,"-",1)_"-"
17 S RCXVDA=RCXVBLNA ; Bill #
18 S RCXVP1=$P(RCXVD1,U,2),RCXVP2=""
19 I RCXVP1'="" S RCXVP2=$P($G(^PRCA(430.2,RCXVP1,0)),U,1)
20 S RCXVDA=RCXVDA_RCXVU_RCXVP2 ; Cat (P)
21 S RCXVDA=RCXVDA_RCXVU_$P(RCXVD1,U,3) ; Orig Amt
22 S RCXVDA=RCXVDA_RCXVU_$P(RCXVD1,U,4) ; GL #
23 S RCXVP1=$P(RCXVD1,U,8),RCXVP2=""
24 I RCXVP1'="" S RCXVP2=$P($G(^PRCA(430.3,RCXVP1,0)),U,1)
25 S RCXVDA=RCXVDA_RCXVU_RCXVP2 ; Cur Stat (P)
26 S RCXVDBN=$$GET1^DIQ(430,RCXVBLN_",",9,"I")
27 I RCXVDBN'="" S RCXVDBN=$P($G(^RCD(340,RCXVDBN,0)),U,1) I RCXVDBN="" D
28 . NEW CT
29 . S CT=$G(^TMP("RCXVBREC",$J,0))+1,^TMP("RCXVBREC",$J,0)=CT
30 . S ^TMP("RCXVBREC",$J,CT,0)="Bill # "_$P(^PRCA(430,RCXVBLN,0),"^",1)_" has a bad debtor record."
31 I RCXVDBN["DPT",DFN="" S DFN=$P(RCXVDBN,";",1)
32 S RCXVVP1=$S(RCXVDBN["DPT":"PATIENT",1:$$GET1^DIQ(430,RCXVBLN_",",9,"E"))
33 S RCXVDA=RCXVDA_RCXVU_RCXVVP1 ; Debtor (P)
34 S RCXVDT=$P(RCXVD1,U,10)
35 S RCXVDA=RCXVDA_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ; DT Bill Preprd
36 S RCXVY(430,11,1)=$G(^PRCA(430,RCXVBLN,7)) ; Cur Bal - Comp
37 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)
38 S RCXVDA=RCXVDA_RCXVU_RCXVX ; Cur. Bal. - computed
39 S RCXVDT=$P(RCXVD1,U,14)
40 S RCXVDA=RCXVDA_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ; DT Stat Upd
41 S RCXVDT=$P($P(RCXVD2,U,21),".",1)
42 S RCXVDB=$$HLDATE^HLFNC(RCXVDT) ; DT acct actd
43 S RCXVDT=$P(RCXVD2,U,1)
44 S RCXVDB=RCXVDB_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ; Letter 1 (DT)
45 S RCXVDT=$P(RCXVD2,U,4)
46 S RCXVDB=RCXVDB_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ; Ref DT
47 S RCXVDB=RCXVDB_RCXVU_$P(RCXVD2,U,5) ; RF code
48 S RCXVDB=RCXVDB_RCXVU_$P(RCXVD2,U,6) ; RF amt
49 S RCXVDT=$P(RCXVD2,U,10)
50 S RCXVDB=RCXVDB_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ; RF DT
51 S RCXVDT=$P(RCXVD2,U,11)
52 S RCXVDB=RCXVDB_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ; Rtrn DT
53 S RCXVDT=$P(RCXVD2,U,12)
54 S RCXVDB=RCXVDB_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ; RF DT to COWC
55 S RCXVDB=RCXVDB_RCXVU_$P(RCXVD2,U,13) ; RF amt to COWC
56 S RCXVDB=RCXVDB_RCXVU_$P(RCXVD4,U,23) ; RSC
57 S RCXVDB=RCXVDB_RCXVU_$P(RCXVD3,U,1) ; PRIN BAL
58 S RCXVDC=$P(RCXVD3,U,2) ; INT BAL
59 S RCXVDC=RCXVDC_RCXVU_$P(RCXVD3,U,3) ; ADMIN COST BAL
60 S RCXVDC=RCXVDC_RCXVU_$P(RCXVD3,U,7) ; TOT PAID PRINC
61 S RCXVDC=RCXVDC_RCXVU_$P(RCXVD3,U,8) ; TOT PAID INT
62 S RCXVDC=RCXVDC_RCXVU_$P(RCXVD3,U,9) ; TOT PAID ADMIN
63 S RCXVDC=RCXVDC_RCXVU_$P(RCXVD3,U,10) ; TOT PAID MARSHAL FEE
64 S RCXVDC=RCXVDC_RCXVU_$P(RCXVD4,U,17) ; FUND
65 S RCXVP1=$P(RCXVD4,U,6),RCXVP2=""
66 I RCXVP1'="" S RCXVP2=$P($G(^RC(347.3,RCXVP1,0)),U,1)
67 S RCXVDC=RCXVDC_RCXVU_RCXVP2 ; REV SRCE (P)
68 S RCXVDT=$$DFP^RCXVUTIL(RCXVBLN)
69 S RCXVDC=RCXVDC_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ; DT 1ST PAYMNT
70 S RCXVDC=RCXVDC_RCXVU_$P(RCXVD5,U) ;MEDICARE CONTRACT ADJUSTMENT AMT
71 S RCXVDC=RCXVDC_RCXVU_$P(RCXVD5,U,2) ;MEDICARE UNREIMBURSABLE AMOUNT
72 S RCXVDC=RCXVDC_RCXVU_$P(RCXVD3,U,18) ;REFUNDED AMOUNT
73 S RCXVDT=$P(RCXVD3,U,19)
74 S RCXVDC=RCXVDC_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ;REFUNDED DATE
75 ;
76 S ^TMP($J,RCXVBLN,"1-430A")=RCXVDA
77 S ^TMP($J,RCXVBLN,"1-430B")=RCXVDB
78 S ^TMP($J,RCXVBLN,"1-430C")=RCXVDC
79 Q
80 ;
Note: See TracBrowser for help on using the repository browser.