source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDMCR3B.m@ 1150

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

initial load of WorldVistAEHR
File size: 4.5 KB
RevLine 
[613]1RCDMCR3B ;HEC/SBW - DMC Rated Disability Elig Change - Collect Data ;23/OCT/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,RDBEGDT,RDENDDT) ; 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 Episode of Care data for.
9 ; (Required)
10 ; RDBEGDT - Rated Disability Change Beginning date, (Required)
11 ; RDENDDT - Rated Disability Change Ending Date, (Required)
12 ;Output
13 ; STOPIT - Passed Variable set to 1 if process is to be terminated
14 ; ^TMP($J,"RCDMCR3") with report data and summary data
15 N RCDFN,DEBTOR,IEN,CTR
16 ;Quit if passed parameter variables not populated
17 I $G(BEGDT)'>0,$G(RDBEGDT)'>0,$G(RDENDDT)'>0 Q
18 ;Get Rated Disability Data within passed RD change time frame
19 ;*** call API to get all RD data for given date period
20 K ^TMP($J,"RDCHG")
21 D RDCHG^DGENRDUA("",RDBEGDT,RDENDDT)
22 S RCDFN=0
23 F S RCDFN=$O(^TMP($J,"RDCHG",RCDFN)) Q:RCDFN'>0 D Q:$G(STOPIT)>0
24 . ;Get AR Debtor info from file 340
25 . S DEBTOR=0
26 . F S DEBTOR=$O(^RCD(340,"B",RCDFN_";DPT(",DEBTOR)) Q:DEBTOR'>0 D Q:$G(STOPIT)>0
27 . . ;Get AR Bill Data that is within the last BEGDT time period
28 . . ;for Bill's with a current status of ACTIVE, OPEN, SUSPENDED
29 . . S IEN=0
30 . . F S IEN=$O(^PRCA(430,"C",DEBTOR,IEN)) Q:IEN'>0 D Q:$G(STOPIT)>0
31 . . . N STATUS,BADDATA,OPTDT,DISCHDT,RXDT,NAME,SSN,SSNLF,OPTDT,RXDT
32 . . . N DISCHDT,OCC,BILLNO,CLOC,CNUM
33 . . . S CTR=$G(CTR)+1 ;Counter
34 . . . I CTR#500=0 S STOPIT=$$STOPIT^RCDMCUT2() Q:STOPIT
35 . . . ;Quit if Veteran is SC 50% to 100% or Receiving VA Pension
36 . . . Q:$$DMCELIG^RCDMCUT1(RCDFN)>0
37 . . . S STATUS=$$GET1^DIQ(430,IEN_",",8)
38 . . . ;Quit if Current Status is not Active, Open or Suspended
39 . . . Q:"^ACTIVE^OPEN^SUSPENDED^"'[(U_STATUS_U)
40 . . . ;Get Bill Data
41 . . . S BADDATA=0
42 . . . D GETDATA
43 . . . Q:$G(BADDATA)>0
44 . . . ;Check that Episode of Care is not older than BEGDT
45 . . . ;Quit if there isn't a service date in the last BEGDT days
46 . . . Q:OPTDT<BEGDT&(DISCHDT<BEGDT)&(RXDT<BEGDT)
47 . . . ;Get Rated Disability Data for this veteran.
48 . . . S OCC=0
49 . . . F S OCC=$O(^TMP($J,"RDCHG",RCDFN,OCC)) Q:OCC'>0 D
50 . . . . N RDNODE,RDCHGDT,RDNAME,RDSEXTRE,RDLEXTRE,RDORGDT
51 . . . . S RDNODE=$G(^TMP($J,"RDCHG",RCDFN,OCC))
52 . . . . S RDCHGDT=$P($P(RDNODE,U,1),".",1)
53 . . . . S RDNAME=$P(RDNODE,U,3)
54 . . . . S RDSEXTRE=$P(RDNODE,U,5)
55 . . . . S:RDSEXTRE']"" RDSEXTRE=0
56 . . . . S RDLEXTRE=$P(RDNODE,U,6)
57 . . . . S RDORGDT=$P(RDNODE,U,7)
58 . . . . ;Quit if there isn't a RD Change Date or RD Name
59 . . . . I RDCHGDT'>0,RDNAME']"" Q
60 . . . . S ^TMP($J,"RCDMCR3","DETAIL",NAME,SSNLF,RDCHGDT,RDNAME,RDSEXTRE,BILLNO)=CNUM_U_$G(CLOC)_U_RDLEXTRE_U_RDORGDT_U_RXDT_U_OPTDT_U_DISCHDT_U_STATUS
61 . . . . ;Set total unique veterans
62 . . . . I $D(^TMP($J,"RCDMCR3","VETSSN",SSN))'>0 D
63 . . . . . S ^TMP($J,"RCDMCR3","SUM-VET")=$G(^TMP($J,"RCDMCR3","SUM-VET"))+1
64 . . . . . S ^TMP($J,"RCDMCR3","VETSSN",SSN)=""
65 . . . . ;Set total RD Changes
66 . . . . I $D(^TMP($J,"RCDMCR3","VETSSN",SSN,RDCHGDT,RDNAME,RDSEXTRE))'>0 D
67 . . . . . S ^TMP($J,"RCDMCR3","SUM-RD")=$G(^TMP($J,"RCDMCR3","SUM-RD"))+1
68 . . . . . S ^TMP($J,"RCDMCR3","VETSSN",SSN,RDCHGDT,RDNAME,RDSEXTRE)=""
69 . . . . ;Set total unique bills
70 . . . . I $D(^TMP($J,"RCDMCR3","VETBILL",BILLNO))'>0 D
71 . . . . . S ^TMP($J,"RCDMCR3","SUM-BILL")=$G(^TMP($J,"RCDMCR3","SUM-BILL"))+1
72 . . . . . S ^TMP($J,"RCDMCR3","VETBILL",BILLNO)=""
73 K ^TMP($J,"RDCHG")
74 Q
75 ;
76GETDATA ;Get data for report
77 ;Get AR Bill Data - Bill #, Patient, Current Status,
78 ;Principal Balance, Name SSN, Service Dates
79 ;Rated Disability Eligibility Data
80 N DFN,SERDT
81 S DFN=$G(RCDFN)
82 ;Quit if DFN not set
83 I DFN'>0 S BADDATA=1 Q
84 ;
85 ;IEN is from calling routine
86 ;Bill Number
87 S BILLNO=$$GET1^DIQ(430,IEN_",",.01)
88 I BILLNO']"" S BADDATA=1 Q
89 ;
90 ;Get Demographic Data
91 D DEM^VADPT
92 I $G(VAERR)>0 S BADDATA=1 D KVAR^VADPT Q
93 S NAME=$G(VADM(1))
94 I NAME']"" S BADDATA=1 Q
95 S SSN=$P(VADM(2),U,1)
96 S SSNLF=$G(VA("BID"))
97 I SSNLF']"" S BADDATA=1 Q
98 ;
99 ;Get Eligibility Data
100 D ELIG^VADPT
101 S CNUM=$G(VAEL(7))
102 ;If claim # same as SSN, block first 5 characters
103 I CNUM]"",CNUM=SSN S CNUM="#####"_$E(CNUM,6,10)
104 D KVAR^VADPT
105 ;Get Station Number in file #4 for the Claim Folder Location in file #2
106 I CNUM]"" D
107 . S CLOC=$$GET1^DIQ(4,+$$GET1^DIQ(2,DFN_",",.314,"I","","ERR")_",",99)
108 ;
109 ;Get Service Date
110 S SERDT=$$GETSERDT^RCDMCUT1(BILLNO)
111 ;Get outpatient date
112 S OPTDT=$P(SERDT,U,2)
113 ;Get Inpatient Discharge date
114 S DISCHDT=$P(SERDT,U,3)
115 ;Get RX fill/refill date
116 S RXDT=$P(SERDT,U,4)
117 Q
Note: See TracBrowser for help on using the repository browser.