RCDMCR1B ;HEC/SBW - DMC Debt Validity Report - Collect Data ;28/SEP/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) ; Get the report data
;Input
; STOPIT - Passed Variable to determine if process is to be terminated
; BEGDT - Beginning Date (in past) to get data for. Optional, Set
; 365 days in past if not passed.
;Output
; STOPIT - Passed Variable set to 1 if process is to be terminated
; ^TMP($J,"RCDMCR1") with report data and summary data
N STAT,RDATE,IEN,CTR
S:$G(BEGDT)'>0 BEGDT=$$FMADD^XLFDT(DT,-365,0,0,0)
;Get AR Bill Data that is within the last 365 days
;for Bill's with a current status of ACTIVE, OPENED, SUSPENDED
F STAT=16,40,42 D Q:$G(STOPIT)>0
. S RDATE=BEGDT-1
. F S RDATE=$O(^PRCA(430,"ASDT",STAT,RDATE)) Q:RDATE'>0 D Q:$G(STOPIT)>0
. . S IEN=0
. . F S IEN=$O(^PRCA(430,"ASDT",STAT,RDATE,IEN)) Q:IEN'>0 D Q:$G(STOPIT)>0
. . . N FIRSTPAR,BADDATA,DMCVALID,DFN,STATUS,NAME,SSNLF,BILLNO,CNUM,CLOC
. . . N ELIG1,ELIGDT,RXDT,OPTDT,DISCHDT,DMCREFDT,DMCVALID,SSN,PRINAMT
. . . S CTR=$G(CTR)+1 ;Counter
. . . I CTR#500=0 S STOPIT=$$STOPIT^RCDMCUT2() Q:STOPIT
. . . ;Quit if bill is not a First Party Bill
. . . S FIRSTPAR=$$FIRSTPAR^RCDMCUT1(IEN)
. . . Q:+FIRSTPAR'>0
. . . ;Get Report Data
. . . S DMCVALID=$$GET1^DIQ(430,IEN_",",125,"E")
. . . ;Quit if DMC Debt Valid Field equal "YES" or "NO"
. . . Q:DMCVALID="YES"!(DMCVALID="NO")
. . . ;Quit if Veteran is not SC 50% to 100% & not Receiving VA Pension
. . . S DFN=$$GET1^DIQ(430,IEN_",",7,"I")
. . . ;If patient field blank get DFN from AR Debtor File
. . . S:DFN'>0 DFN=$P(FIRSTPAR,U,2)
. . . Q:$$DMCELIG^RCDMCUT1(DFN)'>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 365
. . . ;Quit if there isn't a service date in the last 365 days
. . . Q:OPTDT<BEGDT&(DISCHDT<BEGDT)&(RXDT<BEGDT)
. . . 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
. . . ;Get Summary DMC Referred Data
. . . I DMCREFDT>0 D
. . . . ;Set total DMC referred bills
. . . . S ^TMP($J,"RCDMCR1","SUM-BILL")=$G(^TMP($J,"RCDMCR1","SUM-BILL"))+1
. . . . ;Set total DMC referred AR dollars
. . . . S ^TMP($J,"RCDMCR1","SUM-$")=$G(^TMP($J,"RCDMCR1","SUM-$"))+PRINAMT
. . . . ;Set total DMC referred unique veterans
. . . . I $D(^TMP($J,"RCDMCR1","VETSSN",SSN))'>0 D
. . . . . S ^TMP($J,"RCDMCR1","SUM-VET")=$G(^TMP($J,"RCDMCR1","SUM-VET"))+1
. . . . . S ^TMP($J,"RCDMCR1","VETSSN",SSN)=""
. . . ;Get Summary for all records
. . . ;Set total bills
. . . S ^TMP($J,"RCDMCR1","TOT-BILL")=$G(^TMP($J,"RCDMCR1","TOT-BILL"))+1
. . . ;Set total AR dollars
. . . S ^TMP($J,"RCDMCR1","TOT-$")=$G(^TMP($J,"RCDMCR1","TOT-$"))+PRINAMT
. . . ;Set total unique veterans
. . . I $D(^TMP($J,"RCDMCR1","TOTVETSSN",SSN))'>0 D
. . . . S ^TMP($J,"RCDMCR1","TOT-VET")=$G(^TMP($J,"RCDMCR1","TOT-VET"))+1
. . . . S ^TMP($J,"RCDMCR1","TOTVETSSN",SSN)=""
Q
;
GETDATA ;Get data for report
;Get AR Bill Data - Bill #, Patient, Current Status,
;Principal Balance, Date Sent to DMC, DMC Debt Valid, Name
;SSN, Eligibility data, Service Dates
N IENS,ARDATA,ERR,ELIG,SCPER,VAPEN,SERDT
;Quit if DFN not set
I DFN'>0 S BADDATA=1 Q
;
;IEN is from calling routine
S IENS=IEN_","
D GETS^DIQ(430,IENS,".01;71;121","EIN","ARDATA","ERR")
;Bill Number
S BILLNO=$G(ARDATA(430,IENS,.01,"E"))
I BILLNO']"" S BADDATA=1 Q
;Principle amount
S PRINAMT=$G(ARDATA(430,IENS,71,"I"))
; DMC Referral Date
S DMCREFDT=$G(ARDATA(430,IENS,121,"I"))
;
;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
S ELIG=$$DMCELIG^RCDMCUT1(DFN)
;Get SC percentage data
S SCPER=$P(ELIG,U,2)
;Get VA Pension data
S VAPEN=$P(ELIG,U,3)
;Check if Receiving A&A Benefits or Housebound Benefits, This also
;indicates that the veteran is Receiving a VA Pension
I $P(ELIG,U,4)>0!($P(ELIG,U,5)>0) S VAPEN=1
;Format SC and VA Pension data
I SCPER>49 S ELIG1="SC"_SCPER_"%" D
. ;If SC 50% to 100% the get Eff. Date Combined SC% Eval.
. S ELIGDT=$$GET1^DIQ(2,DFN_",",.3014,"I")
I VAPEN>0 D
. ;Put "/" between SC & VA Pension data
. I $G(ELIG1)]"" S ELIG1=ELIG1_"/"
. S ELIG1=$G(ELIG1)_"Pension"
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[HRCDMCR1B 5333 printed Sep 23, 2025@19:19:32 Page 2
RCDMCR1B ;HEC/SBW - DMC Debt Validity Report - Collect Data ;28/SEP/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) ; 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 data for. Optional, Set
+4 ; 365 days in past if not passed.
+5 ;Output
+6 ; STOPIT - Passed Variable set to 1 if process is to be terminated
+7 ; ^TMP($J,"RCDMCR1") with report data and summary data
+8 NEW STAT,RDATE,IEN,CTR
+9 if $GET(BEGDT)'>0
SET BEGDT=$$FMADD^XLFDT(DT,-365,0,0,0)
+10 ;Get AR Bill Data that is within the last 365 days
+11 ;for Bill's with a current status of ACTIVE, OPENED, SUSPENDED
+12 FOR STAT=16,40,42
Begin DoDot:1
+13 SET RDATE=BEGDT-1
+14 FOR
SET RDATE=$ORDER(^PRCA(430,"ASDT",STAT,RDATE))
if RDATE'>0
QUIT
Begin DoDot:2
+15 SET IEN=0
+16 FOR
SET IEN=$ORDER(^PRCA(430,"ASDT",STAT,RDATE,IEN))
if IEN'>0
QUIT
Begin DoDot:3
+17 NEW FIRSTPAR,BADDATA,DMCVALID,DFN,STATUS,NAME,SSNLF,BILLNO,CNUM,CLOC
+18 NEW ELIG1,ELIGDT,RXDT,OPTDT,DISCHDT,DMCREFDT,DMCVALID,SSN,PRINAMT
+19 ;Counter
SET CTR=$GET(CTR)+1
+20 IF CTR#500=0
SET STOPIT=$$STOPIT^RCDMCUT2()
if STOPIT
QUIT
+21 ;Quit if bill is not a First Party Bill
+22 SET FIRSTPAR=$$FIRSTPAR^RCDMCUT1(IEN)
+23 if +FIRSTPAR'>0
QUIT
+24 ;Get Report Data
+25 SET DMCVALID=$$GET1^DIQ(430,IEN_",",125,"E")
+26 ;Quit if DMC Debt Valid Field equal "YES" or "NO"
+27 if DMCVALID="YES"!(DMCVALID="NO")
QUIT
+28 ;Quit if Veteran is not SC 50% to 100% & not Receiving VA Pension
+29 SET DFN=$$GET1^DIQ(430,IEN_",",7,"I")
+30 ;If patient field blank get DFN from AR Debtor File
+31 if DFN'>0
SET DFN=$PIECE(FIRSTPAR,U,2)
+32 if $$DMCELIG^RCDMCUT1(DFN)'>0
QUIT
+33 SET STATUS=$$GET1^DIQ(430,IEN_",",8)
+34 ;Quit if Current Status is not Active, Open or Suspended
+35 if "^ACTIVE^OPEN^SUSPENDED^"'[(U_STATUS_U)
QUIT
+36 ;Get Bill Data
+37 SET BADDATA=0
+38 DO GETDATA
+39 if $GET(BADDATA)>0
QUIT
+40 ;Check that Episode of Care is not older than 365
+41 ;Quit if there isn't a service date in the last 365 days
+42 if OPTDT<BEGDT&(DISCHDT<BEGDT)&(RXDT<BEGDT)
QUIT
+43 SET ^TMP($JOB,"RCDMCR1","DETAIL",NAME,SSNLF,BILLNO)=CNUM_U_$GET(CLOC)_U_$GET(ELIG1)_U_$GET(ELIGDT)_U_RXDT_U_OPTDT_U_DISCHDT_U_DMCREFDT_U_DMCVALID_U_STATUS
+44 ;Get Summary DMC Referred Data
+45 IF DMCREFDT>0
Begin DoDot:4
+46 ;Set total DMC referred bills
+47 SET ^TMP($JOB,"RCDMCR1","SUM-BILL")=$GET(^TMP($JOB,"RCDMCR1","SUM-BILL"))+1
+48 ;Set total DMC referred AR dollars
+49 SET ^TMP($JOB,"RCDMCR1","SUM-$")=$GET(^TMP($JOB,"RCDMCR1","SUM-$"))+PRINAMT
+50 ;Set total DMC referred unique veterans
+51 IF $DATA(^TMP($JOB,"RCDMCR1","VETSSN",SSN))'>0
Begin DoDot:5
+52 SET ^TMP($JOB,"RCDMCR1","SUM-VET")=$GET(^TMP($JOB,"RCDMCR1","SUM-VET"))+1
+53 SET ^TMP($JOB,"RCDMCR1","VETSSN",SSN)=""
End DoDot:5
End DoDot:4
+54 ;Get Summary for all records
+55 ;Set total bills
+56 SET ^TMP($JOB,"RCDMCR1","TOT-BILL")=$GET(^TMP($JOB,"RCDMCR1","TOT-BILL"))+1
+57 ;Set total AR dollars
+58 SET ^TMP($JOB,"RCDMCR1","TOT-$")=$GET(^TMP($JOB,"RCDMCR1","TOT-$"))+PRINAMT
+59 ;Set total unique veterans
+60 IF $DATA(^TMP($JOB,"RCDMCR1","TOTVETSSN",SSN))'>0
Begin DoDot:4
+61 SET ^TMP($JOB,"RCDMCR1","TOT-VET")=$GET(^TMP($JOB,"RCDMCR1","TOT-VET"))+1
+62 SET ^TMP($JOB,"RCDMCR1","TOTVETSSN",SSN)=""
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
+63 QUIT
+64 ;
GETDATA ;Get data for report
+1 ;Get AR Bill Data - Bill #, Patient, Current Status,
+2 ;Principal Balance, Date Sent to DMC, DMC Debt Valid, Name
+3 ;SSN, Eligibility data, Service Dates
+4 NEW IENS,ARDATA,ERR,ELIG,SCPER,VAPEN,SERDT
+5 ;Quit if DFN not set
+6 IF DFN'>0
SET BADDATA=1
QUIT
+7 ;
+8 ;IEN is from calling routine
+9 SET IENS=IEN_","
+10 DO GETS^DIQ(430,IENS,".01;71;121","EIN","ARDATA","ERR")
+11 ;Bill Number
+12 SET BILLNO=$GET(ARDATA(430,IENS,.01,"E"))
+13 IF BILLNO']""
SET BADDATA=1
QUIT
+14 ;Principle amount
+15 SET PRINAMT=$GET(ARDATA(430,IENS,71,"I"))
+16 ; DMC Referral Date
+17 SET DMCREFDT=$GET(ARDATA(430,IENS,121,"I"))
+18 ;
+19 ;Get Demographic Data
+20 DO DEM^VADPT
+21 IF $GET(VAERR)>0
SET BADDATA=1
DO KVAR^VADPT
QUIT
+22 SET NAME=$GET(VADM(1))
+23 IF NAME']""
SET BADDATA=1
QUIT
+24 SET SSN=$PIECE(VADM(2),U,1)
+25 SET SSNLF=$GET(VA("BID"))
+26 IF SSNLF']""
SET BADDATA=1
QUIT
+27 ;
+28 ;Get Eligibility Data
+29 SET ELIG=$$DMCELIG^RCDMCUT1(DFN)
+30 ;Get SC percentage data
+31 SET SCPER=$PIECE(ELIG,U,2)
+32 ;Get VA Pension data
+33 SET VAPEN=$PIECE(ELIG,U,3)
+34 ;Check if Receiving A&A Benefits or Housebound Benefits, This also
+35 ;indicates that the veteran is Receiving a VA Pension
+36 IF $PIECE(ELIG,U,4)>0!($PIECE(ELIG,U,5)>0)
SET VAPEN=1
+37 ;Format SC and VA Pension data
+38 IF SCPER>49
SET ELIG1="SC"_SCPER_"%"
Begin DoDot:1
+39 ;If SC 50% to 100% the get Eff. Date Combined SC% Eval.
+40 SET ELIGDT=$$GET1^DIQ(2,DFN_",",.3014,"I")
End DoDot:1
+41 IF VAPEN>0
Begin DoDot:1
+42 ;Put "/" between SC & VA Pension data
+43 IF $GET(ELIG1)]""
SET ELIG1=ELIG1_"/"
+44 SET ELIG1=$GET(ELIG1)_"Pension"
End DoDot:1
+45 DO ELIG^VADPT
+46 SET CNUM=$GET(VAEL(7))
+47 ;If claim # same as SSN, block first 5 characters
+48 IF CNUM]""
IF CNUM=SSN
SET CNUM="#####"_$EXTRACT(CNUM,6,10)
+49 DO KVAR^VADPT
+50 ;Get Station Number in file #4 for the Claim Folder Location in file #2
+51 IF CNUM]""
Begin DoDot:1
+52 SET CLOC=$$GET1^DIQ(4,+$$GET1^DIQ(2,DFN_",",.314,"I","","ERR")_",",99)
End DoDot:1
+53 ;
+54 ;Get Service Date
+55 SET SERDT=$$GETSERDT^RCDMCUT1(BILLNO)
+56 ;Get outpatient date
+57 SET OPTDT=$PIECE(SERDT,U,2)
+58 ;Get Inpatient Discharge date
+59 SET DISCHDT=$PIECE(SERDT,U,3)
+60 ;Get RX fill/refill date
+61 SET RXDT=$PIECE(SERDT,U,4)
+62 QUIT
