RCDMCR3B ;HEC/SBW - DMC Rated Disability Elig Change - Collect Data ;23/OCT/2007
;;4.5;Accounts Receivable;**253**;Mar 20, 1995;Build 9
;;Per VHA Directive 2004-038, this routine should not be modified.
;
COLLECT(STOPIT,BEGDT,RDBEGDT,RDENDDT) ; Get the report data
;Input
; STOPIT - Passed Variable to determine if process is to be terminated
; BEGDT - Beginning Date (in past) to get Episode of Care data for.
; (Required)
; RDBEGDT - Rated Disability Change Beginning date, (Required)
; RDENDDT - Rated Disability Change Ending Date, (Required)
;Output
; STOPIT - Passed Variable set to 1 if process is to be terminated
; ^TMP($J,"RCDMCR3") with report data and summary data
N RCDFN,DEBTOR,IEN,CTR
;Quit if passed parameter variables not populated
I $G(BEGDT)'>0,$G(RDBEGDT)'>0,$G(RDENDDT)'>0 Q
;Get Rated Disability Data within passed RD change time frame
;*** call API to get all RD data for given date period
K ^TMP($J,"RDCHG")
D RDCHG^DGENRDUA("",RDBEGDT,RDENDDT)
S RCDFN=0
F S RCDFN=$O(^TMP($J,"RDCHG",RCDFN)) Q:RCDFN'>0 D Q:$G(STOPIT)>0
. ;Get AR Debtor info from file 340
. S DEBTOR=0
. F S DEBTOR=$O(^RCD(340,"B",RCDFN_";DPT(",DEBTOR)) Q:DEBTOR'>0 D Q:$G(STOPIT)>0
. . ;Get AR Bill Data that is within the last BEGDT time period
. . ;for Bill's with a current status of ACTIVE, OPEN, SUSPENDED
. . S IEN=0
. . F S IEN=$O(^PRCA(430,"C",DEBTOR,IEN)) Q:IEN'>0 D Q:$G(STOPIT)>0
. . . N STATUS,BADDATA,OPTDT,DISCHDT,RXDT,NAME,SSN,SSNLF,OPTDT,RXDT
. . . N DISCHDT,OCC,BILLNO,CLOC,CNUM
. . . S CTR=$G(CTR)+1 ;Counter
. . . I CTR#500=0 S STOPIT=$$STOPIT^RCDMCUT2() Q:STOPIT
. . . ;Quit if Veteran is SC 50% to 100% or Receiving VA Pension
. . . Q:$$DMCELIG^RCDMCUT1(RCDFN)>0
. . . S STATUS=$$GET1^DIQ(430,IEN_",",8)
. . . ;Quit if Current Status is not Active, Open or Suspended
. . . Q:"^ACTIVE^OPEN^SUSPENDED^"'[(U_STATUS_U)
. . . ;Get Bill Data
. . . S BADDATA=0
. . . D GETDATA
. . . Q:$G(BADDATA)>0
. . . ;Check that Episode of Care is not older than BEGDT
. . . ;Quit if there isn't a service date in the last BEGDT days
. . . Q:OPTDT<BEGDT&(DISCHDT<BEGDT)&(RXDT<BEGDT)
. . . ;Get Rated Disability Data for this veteran.
. . . S OCC=0
. . . F S OCC=$O(^TMP($J,"RDCHG",RCDFN,OCC)) Q:OCC'>0 D
. . . . N RDNODE,RDCHGDT,RDNAME,RDSEXTRE,RDLEXTRE,RDORGDT
. . . . S RDNODE=$G(^TMP($J,"RDCHG",RCDFN,OCC))
. . . . S RDCHGDT=$P($P(RDNODE,U,1),".",1)
. . . . S RDNAME=$P(RDNODE,U,3)
. . . . S RDSEXTRE=$P(RDNODE,U,5)
. . . . S:RDSEXTRE']"" RDSEXTRE=0
. . . . S RDLEXTRE=$P(RDNODE,U,6)
. . . . S RDORGDT=$P(RDNODE,U,7)
. . . . ;Quit if there isn't a RD Change Date or RD Name
. . . . I RDCHGDT'>0,RDNAME']"" Q
. . . . 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
. . . . ;Set total unique veterans
. . . . I $D(^TMP($J,"RCDMCR3","VETSSN",SSN))'>0 D
. . . . . S ^TMP($J,"RCDMCR3","SUM-VET")=$G(^TMP($J,"RCDMCR3","SUM-VET"))+1
. . . . . S ^TMP($J,"RCDMCR3","VETSSN",SSN)=""
. . . . ;Set total RD Changes
. . . . I $D(^TMP($J,"RCDMCR3","VETSSN",SSN,RDCHGDT,RDNAME,RDSEXTRE))'>0 D
. . . . . S ^TMP($J,"RCDMCR3","SUM-RD")=$G(^TMP($J,"RCDMCR3","SUM-RD"))+1
. . . . . S ^TMP($J,"RCDMCR3","VETSSN",SSN,RDCHGDT,RDNAME,RDSEXTRE)=""
. . . . ;Set total unique bills
. . . . I $D(^TMP($J,"RCDMCR3","VETBILL",BILLNO))'>0 D
. . . . . S ^TMP($J,"RCDMCR3","SUM-BILL")=$G(^TMP($J,"RCDMCR3","SUM-BILL"))+1
. . . . . S ^TMP($J,"RCDMCR3","VETBILL",BILLNO)=""
K ^TMP($J,"RDCHG")
Q
;
GETDATA ;Get data for report
;Get AR Bill Data - Bill #, Patient, Current Status,
;Principal Balance, Name SSN, Service Dates
;Rated Disability Eligibility Data
N DFN,SERDT
S DFN=$G(RCDFN)
;Quit if DFN not set
I DFN'>0 S BADDATA=1 Q
;
;IEN is from calling routine
;Bill Number
S BILLNO=$$GET1^DIQ(430,IEN_",",.01)
I BILLNO']"" S BADDATA=1 Q
;
;Get Demographic Data
D DEM^VADPT
I $G(VAERR)>0 S BADDATA=1 D KVAR^VADPT Q
S NAME=$G(VADM(1))
I NAME']"" S BADDATA=1 Q
S SSN=$P(VADM(2),U,1)
S SSNLF=$G(VA("BID"))
I SSNLF']"" S BADDATA=1 Q
;
;Get Eligibility Data
D ELIG^VADPT
S CNUM=$G(VAEL(7))
;If claim # same as SSN, block first 5 characters
I CNUM]"",CNUM=SSN S CNUM="#####"_$E(CNUM,6,10)
D KVAR^VADPT
;Get Station Number in file #4 for the Claim Folder Location in file #2
I CNUM]"" D
. S CLOC=$$GET1^DIQ(4,+$$GET1^DIQ(2,DFN_",",.314,"I","","ERR")_",",99)
;
;Get Service Date
S SERDT=$$GETSERDT^RCDMCUT1(BILLNO)
;Get outpatient date
S OPTDT=$P(SERDT,U,2)
;Get Inpatient Discharge date
S DISCHDT=$P(SERDT,U,3)
;Get RX fill/refill date
S RXDT=$P(SERDT,U,4)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDMCR3B 4776 printed Sep 23, 2025@19:19:36 Page 2
RCDMCR3B ;HEC/SBW - DMC Rated Disability Elig Change - Collect Data ;23/OCT/2007
+1 ;;4.5;Accounts Receivable;**253**;Mar 20, 1995;Build 9
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
COLLECT(STOPIT,BEGDT,RDBEGDT,RDENDDT) ; Get the report data
+1 ;Input
+2 ; STOPIT - Passed Variable to determine if process is to be terminated
+3 ; BEGDT - Beginning Date (in past) to get Episode of Care data for.
+4 ; (Required)
+5 ; RDBEGDT - Rated Disability Change Beginning date, (Required)
+6 ; RDENDDT - Rated Disability Change Ending Date, (Required)
+7 ;Output
+8 ; STOPIT - Passed Variable set to 1 if process is to be terminated
+9 ; ^TMP($J,"RCDMCR3") with report data and summary data
+10 NEW RCDFN,DEBTOR,IEN,CTR
+11 ;Quit if passed parameter variables not populated
+12 IF $GET(BEGDT)'>0
IF $GET(RDBEGDT)'>0
IF $GET(RDENDDT)'>0
QUIT
+13 ;Get Rated Disability Data within passed RD change time frame
+14 ;*** call API to get all RD data for given date period
+15 KILL ^TMP($JOB,"RDCHG")
+16 DO RDCHG^DGENRDUA("",RDBEGDT,RDENDDT)
+17 SET RCDFN=0
+18 FOR
SET RCDFN=$ORDER(^TMP($JOB,"RDCHG",RCDFN))
if RCDFN'>0
QUIT
Begin DoDot:1
+19 ;Get AR Debtor info from file 340
+20 SET DEBTOR=0
+21 FOR
SET DEBTOR=$ORDER(^RCD(340,"B",RCDFN_";DPT(",DEBTOR))
if DEBTOR'>0
QUIT
Begin DoDot:2
+22 ;Get AR Bill Data that is within the last BEGDT time period
+23 ;for Bill's with a current status of ACTIVE, OPEN, SUSPENDED
+24 SET IEN=0
+25 FOR
SET IEN=$ORDER(^PRCA(430,"C",DEBTOR,IEN))
if IEN'>0
QUIT
Begin DoDot:3
+26 NEW STATUS,BADDATA,OPTDT,DISCHDT,RXDT,NAME,SSN,SSNLF,OPTDT,RXDT
+27 NEW DISCHDT,OCC,BILLNO,CLOC,CNUM
+28 ;Counter
SET CTR=$GET(CTR)+1
+29 IF CTR#500=0
SET STOPIT=$$STOPIT^RCDMCUT2()
if STOPIT
QUIT
+30 ;Quit if Veteran is SC 50% to 100% or Receiving VA Pension
+31 if $$DMCELIG^RCDMCUT1(RCDFN)>0
QUIT
+32 SET STATUS=$$GET1^DIQ(430,IEN_",",8)
+33 ;Quit if Current Status is not Active, Open or Suspended
+34 if "^ACTIVE^OPEN^SUSPENDED^"'[(U_STATUS_U)
QUIT
+35 ;Get Bill Data
+36 SET BADDATA=0
+37 DO GETDATA
+38 if $GET(BADDATA)>0
QUIT
+39 ;Check that Episode of Care is not older than BEGDT
+40 ;Quit if there isn't a service date in the last BEGDT days
+41 if OPTDT<BEGDT&(DISCHDT<BEGDT)&(RXDT<BEGDT)
QUIT
+42 ;Get Rated Disability Data for this veteran.
+43 SET OCC=0
+44 FOR
SET OCC=$ORDER(^TMP($JOB,"RDCHG",RCDFN,OCC))
if OCC'>0
QUIT
Begin DoDot:4
+45 NEW RDNODE,RDCHGDT,RDNAME,RDSEXTRE,RDLEXTRE,RDORGDT
+46 SET RDNODE=$GET(^TMP($JOB,"RDCHG",RCDFN,OCC))
+47 SET RDCHGDT=$PIECE($PIECE(RDNODE,U,1),".",1)
+48 SET RDNAME=$PIECE(RDNODE,U,3)
+49 SET RDSEXTRE=$PIECE(RDNODE,U,5)
+50 if RDSEXTRE']""
SET RDSEXTRE=0
+51 SET RDLEXTRE=$PIECE(RDNODE,U,6)
+52 SET RDORGDT=$PIECE(RDNODE,U,7)
+53 ;Quit if there isn't a RD Change Date or RD Name
+54 IF RDCHGDT'>0
IF RDNAME']""
QUIT
+55 SET ^TMP($JOB,"RCDMCR3","DETAIL",NAME,SSNLF,RDCHGDT,RDNAME,RDSEXTRE,BILLNO)=CNUM_U_$GET(CLOC)_U_RDLEXTRE_U_RDORGDT_U_RXDT_U_OPTDT_U_DISCHDT_U_STATUS
+56 ;Set total unique veterans
+57 IF $DATA(^TMP($JOB,"RCDMCR3","VETSSN",SSN))'>0
Begin DoDot:5
+58 SET ^TMP($JOB,"RCDMCR3","SUM-VET")=$GET(^TMP($JOB,"RCDMCR3","SUM-VET"))+1
+59 SET ^TMP($JOB,"RCDMCR3","VETSSN",SSN)=""
End DoDot:5
+60 ;Set total RD Changes
+61 IF $DATA(^TMP($JOB,"RCDMCR3","VETSSN",SSN,RDCHGDT,RDNAME,RDSEXTRE))'>0
Begin DoDot:5
+62 SET ^TMP($JOB,"RCDMCR3","SUM-RD")=$GET(^TMP($JOB,"RCDMCR3","SUM-RD"))+1
+63 SET ^TMP($JOB,"RCDMCR3","VETSSN",SSN,RDCHGDT,RDNAME,RDSEXTRE)=""
End DoDot:5
+64 ;Set total unique bills
+65 IF $DATA(^TMP($JOB,"RCDMCR3","VETBILL",BILLNO))'>0
Begin DoDot:5
+66 SET ^TMP($JOB,"RCDMCR3","SUM-BILL")=$GET(^TMP($JOB,"RCDMCR3","SUM-BILL"))+1
+67 SET ^TMP($JOB,"RCDMCR3","VETBILL",BILLNO)=""
End DoDot:5
End DoDot:4
End DoDot:3
if $GET(STOPIT)>0
QUIT
End DoDot:2
if $GET(STOPIT)>0
QUIT
End DoDot:1
if $GET(STOPIT)>0
QUIT
+68 KILL ^TMP($JOB,"RDCHG")
+69 QUIT
+70 ;
GETDATA ;Get data for report
+1 ;Get AR Bill Data - Bill #, Patient, Current Status,
+2 ;Principal Balance, Name SSN, Service Dates
+3 ;Rated Disability Eligibility Data
+4 NEW DFN,SERDT
+5 SET DFN=$GET(RCDFN)
+6 ;Quit if DFN not set
+7 IF DFN'>0
SET BADDATA=1
QUIT
+8 ;
+9 ;IEN is from calling routine
+10 ;Bill Number
+11 SET BILLNO=$$GET1^DIQ(430,IEN_",",.01)
+12 IF BILLNO']""
SET BADDATA=1
QUIT
+13 ;
+14 ;Get Demographic Data
+15 DO DEM^VADPT
+16 IF $GET(VAERR)>0
SET BADDATA=1
DO KVAR^VADPT
QUIT
+17 SET NAME=$GET(VADM(1))
+18 IF NAME']""
SET BADDATA=1
QUIT
+19 SET SSN=$PIECE(VADM(2),U,1)
+20 SET SSNLF=$GET(VA("BID"))
+21 IF SSNLF']""
SET BADDATA=1
QUIT
+22 ;
+23 ;Get Eligibility Data
+24 DO ELIG^VADPT
+25 SET CNUM=$GET(VAEL(7))
+26 ;If claim # same as SSN, block first 5 characters
+27 IF CNUM]""
IF CNUM=SSN
SET CNUM="#####"_$EXTRACT(CNUM,6,10)
+28 DO KVAR^VADPT
+29 ;Get Station Number in file #4 for the Claim Folder Location in file #2
+30 IF CNUM]""
Begin DoDot:1
+31 SET CLOC=$$GET1^DIQ(4,+$$GET1^DIQ(2,DFN_",",.314,"I","","ERR")_",",99)
End DoDot:1
+32 ;
+33 ;Get Service Date
+34 SET SERDT=$$GETSERDT^RCDMCUT1(BILLNO)
+35 ;Get outpatient date
+36 SET OPTDT=$PIECE(SERDT,U,2)
+37 ;Get Inpatient Discharge date
+38 SET DISCHDT=$PIECE(SERDT,U,3)
+39 ;Get RX fill/refill date
+40 SET RXDT=$PIECE(SERDT,U,4)
+41 QUIT
