source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDMCR2B.m@ 738

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

initial load of WorldVistAEHR

File size: 5.4 KB
Line 
1RCDMCR2B ;HEC/SBW - DMC Debt Validity Management 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,DMCVAL) ; Get the report data
6 ; STOPIT - Passed Variable to determine if process is to be terminated
7 ; BEGDT - Beginning Date (in past) to get data for. Optional, Set
8 ; 365 days in past if not passed.
9 ; DMCVAL - DMC Debt Valid values that will be included in this report
10 ; (i.e. DMCVAL("NULL"), DMCVAL("PENDING"), DMCVAL("YES"),
11 ; or DMCVAL("NO") )
12 ;Output
13 ; STOPIT - Passed Variable set to 1 if process is to be terminated
14 ; ^TMP($J,"RCDMCR2") with report data and summary data
15 N STAT,RDATE,IEN,CTR,BADDATA
16 ;Set BEGDT if valid value not passed
17 S:$G(BEGDT)'>0 BEGDT=$$FMADD^XLFDT(DT,-365,0,0,0)
18 ;Get AR Bill Data that is within the last 365 days
19 ;for Bill's with a current status of ACTIVE, CANCELLATION, SUSPENDED,
20 ;REFUNDED, OPEN, REFUND REVIEW
21 F STAT=16,39,40,41,42,44 D Q:$G(STOPIT)>0
22 . S RDATE=BEGDT-1
23 . F S RDATE=$O(^PRCA(430,"ASDT",STAT,RDATE)) Q:RDATE'>0 D Q:$G(STOPIT)>0
24 . . S IEN=0
25 . . F S IEN=$O(^PRCA(430,"ASDT",STAT,RDATE,IEN)) Q:IEN'>0 D Q:$G(STOPIT)>0
26 . . . S CTR=$G(CTR)+1 ;Counter
27 . . . I CTR#500=0 S STOPIT=$$STOPIT^RCDMCUT2() Q:STOPIT
28 . . . N FIRSTPAR,DMCVALID,DFN,STATUS,NAME,SSN,SSNLF,BILLNO,CNUM,CLOC
29 . . . N PRINAMT,STATUS,EDITBY,EDITDT,OPTDT,DISCHDT,RXDT
30 . . . ;Quit if bill is not a First Party Bill
31 . . . S FIRSTPAR=$$FIRSTPAR^RCDMCUT1(IEN)
32 . . . Q:+FIRSTPAR'>0
33 . . . ;Get Report Data
34 . . . S DMCVALID=$$GET1^DIQ(430,IEN_",",125,"E")
35 . . . ;When DMC Debt VAlid is Null set to string value of "NULL"
36 . . . S:DMCVALID="" DMCVALID="BLANK/NULL"
37 . . . ;Quit if DMC Debt Valid Field not one of the request ones
38 . . . Q:+$D(DMCVAL(DMCVALID))'>0
39 . . . ;Quit if Veteran is not SC 50% to 100% & not Receiving VA Pension
40 . . . S DFN=$$GET1^DIQ(430,IEN_",",7,"I")
41 . . . ;If patient field blank get DFN from AR Debtor File
42 . . . S:DFN'>0 DFN=$P(FIRSTPAR,U,2)
43 . . . Q:$$DMCELIG^RCDMCUT1(DFN)'>0
44 . . . S STATUS=$$GET1^DIQ(430,IEN_",",8)
45 . . . ;Quit if Current Status is not Active, Open, Suspended,
46 . . . ;Cancellation, Refunded, or Refund Review
47 . . . Q:"^ACTIVE^OPEN^SUSPENDED^CANCELLATION^REFUNDED^REFUND REVIEW^"'[(U_STATUS_U)
48 . . . ;Get Bill Data
49 . . . S BADDATA=0
50 . . . D GETDATA
51 . . . Q:BADDATA>0
52 . . . ;Check that Episode of Care is not older than 365
53 . . . ;Quit if there isn't a service date in the last 365 days
54 . . . Q:OPTDT<BEGDT&(DISCHDT<BEGDT)&(RXDT<BEGDT)
55 . . . S ^TMP($J,"RCDMCR2","DETAIL",DMCVALID,NAME,SSNLF,BILLNO)=CNUM_U_$G(CLOC)_U_PRINAMT_U_STATUS_U_EDITBY_U_EDITDT
56 . . . ;Get Summary Data
57 . . . ;Set total AR bills
58 . . . S ^TMP($J,"RCDMCR2","TOT","BILL")=$G(^TMP($J,"RCDMCR2","TOT","BILL"))+1
59 . . . ;Set total AR bills for a given status
60 . . . S ^TMP($J,"RCDMCR2","TOT-STAT",STATUS)=$G(^TMP($J,"RCDMCR2","TOT-STAT",STATUS))+1
61 . . . ;Set total AR (Principle Amt) dollars
62 . . . S ^TMP($J,"RCDMCR2","TOT","$")=$G(^TMP($J,"RCDMCR2","TOT","$"))+PRINAMT
63 . . . ;Set totaL unique veterans
64 . . . I $D(^TMP($J,"RCDMCR2","TOT","VETSSN",SSN))'>0 D
65 . . . . S ^TMP($J,"RCDMCR2","TOT","VET")=$G(^TMP($J,"RCDMCR2","TOT","VET"))+1
66 . . . . S ^TMP($J,"RCDMCR2","TOT","VETSSN",SSN)=""
67 . . . ;Get Summary data by DMC Debt Valid field
68 . . . ;Set total AR bills by DMC Debt Valid field
69 . . . S ^TMP($J,"RCDMCR2","SUM",DMCVALID,"BILL")=$G(^TMP($J,"RCDMCR2","SUM",DMCVALID,"BILL"))+1
70 . . . ;Set total AR bills by DMC Debt Valid value and status
71 . . . S ^TMP($J,"RCDMCR2","SUM-STAT",DMCVALID,STATUS)=$G(^TMP($J,"RCDMCR2","SUM-STAT",DMCVALID,STATUS))+1
72 . . . ;Set total AR (Principle Amt) dollars by DMC Debt Valid value
73 . . . S ^TMP($J,"RCDMCR2","SUM",DMCVALID,"$")=$G(^TMP($J,"RCDMCR2","SUM",DMCVALID,"$"))+PRINAMT
74 . . . ;Set totaL unique veterans by DMC Debt Valid value
75 . . . I $D(^TMP($J,"RCDMCR2","SUM",DMCVALID,"VETSSN",SSN))'>0 D
76 . . . . S ^TMP($J,"RCDMCR2","SUM",DMCVALID,"VET")=$G(^TMP($J,"RCDMCR2","SUM",DMCVALID,"VET"))+1
77 . . . . S ^TMP($J,"RCDMCR2","SUM",DMCVALID,"VETSSN",SSN)=""
78 Q
79 ;
80GETDATA ;Get data for report
81 ;Get AR Bill Data - Bill #, Patient, Current Status,
82 ;Principal Balance, DMC Debt Valid Edited, DMC Debt Valid Edited Date
83 ;Name, SSN, Eligibility Data, Service Dates
84 N IENS,ARDATA,ERR,SERDT
85 ;Quit if DFN not set
86 I DFN'>0 S BADDATA=1 Q
87 ;
88 ;IEN is from calling routine
89 S IENS=IEN_","
90 D GETS^DIQ(430,IENS,".01;71;126;127","EIN","ARDATA","ERR")
91 ;Bill Number
92 S BILLNO=$G(ARDATA(430,IENS,.01,"E"))
93 I BILLNO']"" S BADDATA=1 Q
94 ;Principle amount
95 S PRINAMT=$G(ARDATA(430,IENS,71,"I"))
96 ;DMC Debt Valid Edited By
97 S EDITBY=$G(ARDATA(430,IENS,126,"E"))
98 ;DMC Debt Valid Edited Date
99 S EDITDT=$G(ARDATA(430,IENS,127,"I"))
100 ;
101 ;Get Demographic Data
102 D DEM^VADPT
103 I $G(VAERR)>0 S BADDATA=1 D KVAR^VADPT Q
104 S NAME=$G(VADM(1))
105 I NAME']"" S BADDATA=1 Q
106 S SSN=$P(VADM(2),U,1)
107 S SSNLF=$G(VA("BID"))
108 I SSNLF']"" S BADDATA=1 Q
109 ;
110 D ELIG^VADPT
111 S CNUM=$G(VAEL(7))
112 ;If claim # same as SSN, block first 5 characters
113 I CNUM]"",CNUM=SSN S CNUM="#####"_$E(CNUM,6,10)
114 D KVAR^VADPT
115 ;Get Station Number in file #4 for the Claim Folder Location in file #2
116 I CNUM]"" D
117 . S CLOC=$$GET1^DIQ(4,+$$GET1^DIQ(2,DFN_",",.314,"I","","ERR")_",",99)
118 ;
119 ;Get Service Date
120 S SERDT=$$GETSERDT^RCDMCUT1(BILLNO)
121 ;Get outpatient date
122 S OPTDT=$P(SERDT,U,2)
123 ;Get Inpatient Discharge date
124 S DISCHDT=$P(SERDT,U,3)
125 ;Get RX fill/refill date
126 S RXDT=$P(SERDT,U,4)
127 Q
Note: See TracBrowser for help on using the repository browser.