| 1 | RCDMCR3B ;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 | ;
|
---|
| 5 | COLLECT(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 | ;
|
---|
| 76 | GETDATA ;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
|
---|