source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDMCR1B.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: 5.1 KB
RevLine 
[613]1RCDMCR1B ;HEC/SBW - DMC Debt Validity Report - Collect Data ;28/SEP/2007
2 ;;4.5;Accounts Receivable;**253**;Mar 20, 1995;Build 9
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5COLLECT(STOPIT,BEGDT) ; Get the report data
6 ;Input
7 ; STOPIT - Passed Variable to determine if process is to be terminated
8 ; BEGDT - Beginning Date (in past) to get data for. Optional, Set
9 ; 365 days in past if not passed.
10 ;Output
11 ; STOPIT - Passed Variable set to 1 if process is to be terminated
12 ; ^TMP($J,"RCDMCR1") with report data and summary data
13 N STAT,RDATE,IEN,CTR
14 S:$G(BEGDT)'>0 BEGDT=$$FMADD^XLFDT(DT,-365,0,0,0)
15 ;Get AR Bill Data that is within the last 365 days
16 ;for Bill's with a current status of ACTIVE, OPENED, SUSPENDED
17 F STAT=16,40,42 D Q:$G(STOPIT)>0
18 . S RDATE=BEGDT-1
19 . F S RDATE=$O(^PRCA(430,"ASDT",STAT,RDATE)) Q:RDATE'>0 D Q:$G(STOPIT)>0
20 . . S IEN=0
21 . . F S IEN=$O(^PRCA(430,"ASDT",STAT,RDATE,IEN)) Q:IEN'>0 D Q:$G(STOPIT)>0
22 . . . N FIRSTPAR,BADDATA,DMCVALID,DFN,STATUS,NAME,SSNLF,BILLNO,CNUM,CLOC
23 . . . N ELIG1,ELIGDT,RXDT,OPTDT,DISCHDT,DMCREFDT,DMCVALID,SSN,PRINAMT
24 . . . S CTR=$G(CTR)+1 ;Counter
25 . . . I CTR#500=0 S STOPIT=$$STOPIT^RCDMCUT2() Q:STOPIT
26 . . . ;Quit if bill is not a First Party Bill
27 . . . S FIRSTPAR=$$FIRSTPAR^RCDMCUT1(IEN)
28 . . . Q:+FIRSTPAR'>0
29 . . . ;Get Report Data
30 . . . S DMCVALID=$$GET1^DIQ(430,IEN_",",125,"E")
31 . . . ;Quit if DMC Debt Valid Field equal "YES" or "NO"
32 . . . Q:DMCVALID="YES"!(DMCVALID="NO")
33 . . . ;Quit if Veteran is not SC 50% to 100% & not Receiving VA Pension
34 . . . S DFN=$$GET1^DIQ(430,IEN_",",7,"I")
35 . . . ;If patient field blank get DFN from AR Debtor File
36 . . . S:DFN'>0 DFN=$P(FIRSTPAR,U,2)
37 . . . Q:$$DMCELIG^RCDMCUT1(DFN)'>0
38 . . . S STATUS=$$GET1^DIQ(430,IEN_",",8)
39 . . . ;Quit if Current Status is not Active, Open or Suspended
40 . . . Q:"^ACTIVE^OPEN^SUSPENDED^"'[(U_STATUS_U)
41 . . . ;Get Bill Data
42 . . . S BADDATA=0
43 . . . D GETDATA
44 . . . Q:$G(BADDATA)>0
45 . . . ;Check that Episode of Care is not older than 365
46 . . . ;Quit if there isn't a service date in the last 365 days
47 . . . Q:OPTDT<BEGDT&(DISCHDT<BEGDT)&(RXDT<BEGDT)
48 . . . S ^TMP($J,"RCDMCR1","DETAIL",NAME,SSNLF,BILLNO)=CNUM_U_$G(CLOC)_U_$G(ELIG1)_U_$G(ELIGDT)_U_RXDT_U_OPTDT_U_DISCHDT_U_DMCREFDT_U_DMCVALID_U_STATUS
49 . . . ;Get Summary DMC Referred Data
50 . . . I DMCREFDT>0 D
51 . . . . ;Set total DMC referred bills
52 . . . . S ^TMP($J,"RCDMCR1","SUM-BILL")=$G(^TMP($J,"RCDMCR1","SUM-BILL"))+1
53 . . . . ;Set total DMC referred AR dollars
54 . . . . S ^TMP($J,"RCDMCR1","SUM-$")=$G(^TMP($J,"RCDMCR1","SUM-$"))+PRINAMT
55 . . . . ;Set total DMC referred unique veterans
56 . . . . I $D(^TMP($J,"RCDMCR1","VETSSN",SSN))'>0 D
57 . . . . . S ^TMP($J,"RCDMCR1","SUM-VET")=$G(^TMP($J,"RCDMCR1","SUM-VET"))+1
58 . . . . . S ^TMP($J,"RCDMCR1","VETSSN",SSN)=""
59 . . . ;Get Summary for all records
60 . . . ;Set total bills
61 . . . S ^TMP($J,"RCDMCR1","TOT-BILL")=$G(^TMP($J,"RCDMCR1","TOT-BILL"))+1
62 . . . ;Set total AR dollars
63 . . . S ^TMP($J,"RCDMCR1","TOT-$")=$G(^TMP($J,"RCDMCR1","TOT-$"))+PRINAMT
64 . . . ;Set total unique veterans
65 . . . I $D(^TMP($J,"RCDMCR1","TOTVETSSN",SSN))'>0 D
66 . . . . S ^TMP($J,"RCDMCR1","TOT-VET")=$G(^TMP($J,"RCDMCR1","TOT-VET"))+1
67 . . . . S ^TMP($J,"RCDMCR1","TOTVETSSN",SSN)=""
68 Q
69 ;
70GETDATA ;Get data for report
71 ;Get AR Bill Data - Bill #, Patient, Current Status,
72 ;Principal Balance, Date Sent to DMC, DMC Debt Valid, Name
73 ;SSN, Eligibility data, Service Dates
74 N IENS,ARDATA,ERR,ELIG,SCPER,VAPEN,SERDT
75 ;Quit if DFN not set
76 I DFN'>0 S BADDATA=1 Q
77 ;
78 ;IEN is from calling routine
79 S IENS=IEN_","
80 D GETS^DIQ(430,IENS,".01;71;121","EIN","ARDATA","ERR")
81 ;Bill Number
82 S BILLNO=$G(ARDATA(430,IENS,.01,"E"))
83 I BILLNO']"" S BADDATA=1 Q
84 ;Principle amount
85 S PRINAMT=$G(ARDATA(430,IENS,71,"I"))
86 ; DMC Referral Date
87 S DMCREFDT=$G(ARDATA(430,IENS,121,"I"))
88 ;
89 ;Get Demographic Data
90 D DEM^VADPT
91 I $G(VAERR)>0 S BADDATA=1 D KVAR^VADPT Q
92 S NAME=$G(VADM(1))
93 I NAME']"" S BADDATA=1 Q
94 S SSN=$P(VADM(2),U,1)
95 S SSNLF=$G(VA("BID"))
96 I SSNLF']"" S BADDATA=1 Q
97 ;
98 ;Get Eligibility Data
99 S ELIG=$$DMCELIG^RCDMCUT1(DFN)
100 ;Get SC percentage data
101 S SCPER=$P(ELIG,U,2)
102 ;Get VA Pension data
103 S VAPEN=$P(ELIG,U,3)
104 ;Check if Receiving A&A Benefits or Housebound Benefits, This also
105 ;indicates that the veteran is Receiving a VA Pension
106 I $P(ELIG,U,4)>0!($P(ELIG,U,5)>0) S VAPEN=1
107 ;Format SC and VA Pension data
108 I SCPER>49 S ELIG1="SC"_SCPER_"%" D
109 . ;If SC 50% to 100% the get Eff. Date Combined SC% Eval.
110 . S ELIGDT=$$GET1^DIQ(2,DFN_",",.3014,"I")
111 I VAPEN>0 D
112 . ;Put "/" between SC & VA Pension data
113 . I $G(ELIG1)]"" S ELIG1=ELIG1_"/"
114 . S ELIG1=$G(ELIG1)_"Pension"
115 D ELIG^VADPT
116 S CNUM=$G(VAEL(7))
117 ;If claim # same as SSN, block first 5 characters
118 I CNUM]"",CNUM=SSN S CNUM="#####"_$E(CNUM,6,10)
119 D KVAR^VADPT
120 ;Get Station Number in file #4 for the Claim Folder Location in file #2
121 I CNUM]"" D
122 . S CLOC=$$GET1^DIQ(4,+$$GET1^DIQ(2,DFN_",",.314,"I","","ERR")_",",99)
123 ;
124 ;Get Service Date
125 S SERDT=$$GETSERDT^RCDMCUT1(BILLNO)
126 ;Get outpatient date
127 S OPTDT=$P(SERDT,U,2)
128 ;Get Inpatient Discharge date
129 S DISCHDT=$P(SERDT,U,3)
130 ;Get RX fill/refill date
131 S RXDT=$P(SERDT,U,4)
132 Q
Note: See TracBrowser for help on using the repository browser.