RCDMCR7B ;ALB/YG - 10-40% SC Medical Care Copayment Exempt Charge Reconciliation Report - Collect Data ;Apr 9, 2019@21:06
;;4.5;Accounts Receivable;**347**;Jan 29, 2019;Build 47
;;Per VA Directive 6402, this routine should not be modified.
;
; See RCDMCR7A for detailed description
;
COLLECT(STOPIT,ARTYPE) ; Get the report data
;Input
; STOPIT - Passed Variable to determine if process is to be terminated
; ARTYPE - AR Type 1:Active;2:Open;3:Suspended;4:Collected/Closed;5:On-Hold;6:Write Off;7:All
;Output
; STOPIT - Passed Variable set to 1 if process is to be terminated
; ^TMP($J,"RCDMCR7") with report data and summary data
;N RCDFN,DEBTOR,ARIEN,IBIEN,CTR,EOCOK,IBCNT,EOCDT,DFN,DMCELIG,EFFDT,NAME,SSN
;N STATUS,OPTDT,DISCHDT,RXDT,OPTDT,RXDT,CHGAMT,OCC,BILLNO,RXNUM,RXNAM,DSTATUS,IBDATA
;Get Rated Disability Data within passed RD change time frame
;*** call API to get all RD change data for given date period
N ZR,DEBTPT,WZH,DEBTCNT,DEBTOR,RCDFN,DFN,EXEMPTDT,SZH,VAERR,VADM,ARIEN,CTR
N BILLNO,IBDATA,IBCNT,IBIEN,NAME,SSN,OUT,STATUS,VAEL,SCPER
S DEBTPT=0,WZH=$H*86400+$P($H,",",2)+60,SZH=WZH W !
K ^TMP($J,"RCDMCR7","ARIB")
F DEBTCNT=0:1 S DEBTPT=$O(^RCD(340,"B",DEBTPT)) Q:DEBTPT="" I DEBTPT[";DPT(" D
. ;Get AR Debtor info from file 340
. S DEBTOR=0,RCDFN=$P(DEBTPT,";")
. F S DEBTOR=$O(^RCD(340,"B",DEBTPT,DEBTOR)) Q:DEBTOR'>0 D Q:$G(STOPIT)>0
. . S DFN=RCDFN
. . ;Get Eligibility Data
. . D ELIG^VADPT
. . ;Quit if ^DPT(DFN,0) not defined
. . Q:$G(VAERR)>0
. . ;Get monetary benefit data
. . D MB^VADPT
. . ;SERVICE CONNECTED?
. . S SCPER=$P($G(VAEL(3)),U,2)
. . I SCPER<10!(SCPER>49) Q
. . S EXEMPTDT=$$GET1^DIQ(2,DFN_",",.3014,"I")
. . I DFN'>0 D KVAR^VADPT Q
. . D DEM^VADPT
. . I $G(VAERR)>0 D KVAR^VADPT Q
. . S NAME=$G(VADM(1))
. . I NAME']"" D KVAR^VADPT Q
. . S SSN=$P(VADM(2),U,1)
. . D KVAR^VADPT
. . ;I EXEMPTDT="" S ^TMP($J,"RCDMCR6","DETAIL",NAME,SSN," ",1)=U_U_U_"NODATE" Q
. . ;Get AR Bill Data that is within the last BEGDT time period
. . ;for Bill's with a current status of ACTIVE, OPEN, SUSPENDED, WRITE-OFF, COLLECTED/CLOSED, or IB Status of ON-HOLD
. . K ^TMP($J,"RCDMCR7","ARIB")
. . I $H*86400+$P($H,",",2)>WZH S WZH=$H*86400+$P($H,",",2)+30,$X=0 W *13,$FN(DEBTCNT*100/$P(^RCD(340,0),U,4),",",2),"% done in ",WZH-SZH," seconds"
. . S ARIEN=0
. . I ARTYPE'=5 F S ARIEN=$O(^PRCA(430,"C",DEBTOR,ARIEN)) Q:'ARIEN D Q:$G(STOPIT)>0
. . . S CTR=$G(CTR)+1 ;Counter
. . . I CTR#500=0 S STOPIT=$$STOPIT^RCDMCUT2() I STOPIT Q
. . . S BILLNO=$$GET1^DIQ(430,ARIEN_",",.01)
. . . I BILLNO']"" Q
. . . ; only look at 1st party bills - TBD
. . . I '$$FIRSTPAR^RCDMCUT1(ARIEN) Q
. . . ;IEN is from calling routine (for file 430)
. . . S STATUS=$$GET1^DIQ(430,ARIEN_",",8,"E")
. . . I ARTYPE=1,STATUS'="ACTIVE" Q
. . . I ARTYPE=2,STATUS'="OPEN" Q
. . . I ARTYPE=3,STATUS'="SUSPENDED" Q
. . . I ARTYPE=4,STATUS'="COLLECTED/CLOSED" Q
. . . I ARTYPE=6,STATUS'="WRITE-OFF" Q
. . . I ARTYPE=7,"^ACTIVE^OPEN^SUSPENDED^WRITE-OFF^COLLECTED/CLOSED^CANCELLATION^"'[(U_STATUS_U) Q
. . . ;S SERDT=$$GETIB(BILLNO,.IBDATA)
. . . K IBDATA S IBDATA=0
. . . S IBIEN=""
. . . F S IBIEN=$O(^IB("ABIL",BILLNO,IBIEN)) Q:'IBIEN D
. . . . S OUT=$$GETIB^RCDMCR4B(IBIEN,0)
. . . . I OUT,$P(OUT,U,5)'=10 S:$P(OUT,U,1,2)'=U IBDATA=IBDATA+1,IBDATA(IBDATA)=OUT
. . . I 'IBDATA Q
. . . M ^TMP($J,"RCDMCR7","ARIB",BILLNO,"IBDATA")=IBDATA
. . . S ^TMP($J,"RCDMCR7","ARIB",BILLNO,"STATUS")=STATUS
. . S IBIEN=""
. . I ARTYPE=5!(ARTYPE=7) F S IBIEN=$O(^IB("AH",RCDFN,IBIEN)) Q:IBIEN="" D Q:$G(STOPIT)>0
. . . K IBDATA S IBDATA=0
. . . S CTR=$G(CTR)+1 ;Counter
. . . I CTR#500=0 S STOPIT=$$STOPIT^RCDMCUT2() Q:STOPIT
. . . S BILLNO="/"_IBIEN
. . . S OUT=$$GETIB^RCDMCR4B(IBIEN,1)
. . . I 'OUT Q
. . . I $P(OUT,U,1,2)=U Q
. . . S IBDATA=1,IBDATA(1)=OUT
. . . M ^TMP($J,"RCDMCR7","ARIB",BILLNO,"IBDATA")=IBDATA
. . . S ^TMP($J,"RCDMCR7","ARIB",BILLNO,"STATUS")="ON HOLD"
. . S BILLNO=""
. . F S BILLNO=$O(^TMP($J,"RCDMCR7","ARIB",BILLNO)) Q:BILLNO="" D
. . . K IBDATA M IBDATA=^TMP($J,"RCDMCR7","ARIB",BILLNO,"IBDATA")
. . . S STATUS=^TMP($J,"RCDMCR7","ARIB",BILLNO,"STATUS")
. . . F IBCNT=1:1:IBDATA D
. . . . N DSTATUS,DISCHDT,SERVDT,OPTDT
. . . . ;IBDATA - Array of 1 ^ Outpatient Date ^ Discharge Date ^ RX/Refill Date ^ IB Status ^ RX NUM ^ RX Name ^ CHGAMT
. . . . S OPTDT=$P(IBDATA(IBCNT),U,2)
. . . . S DISCHDT=$P(IBDATA(IBCNT),U,3)
. . . . S SERVDT=$S(OPTDT>DISCHDT:OPTDT,DISCHDT>OPTDT:DISCHDT,1:"")
. . . . ;S RXDT=$P(IBDATA(IBCNT),U,4)
. . . . ;S IBSTATUS=$P(IBDATA(IBCNT),U,5)
. . . . ;S RXNUM=$P(IBDATA(IBCNT),U,6)
. . . . ;S RXNAM=$P(IBDATA(IBCNT),U,7)
. . . . S DSTATUS=STATUS
. . . . ; this node will be set over and over again, but it is one node per NODATE debtor
. . . . I EXEMPTDT="" S ^TMP($J,"RCDMCR7","DETAIL",NAME,SSN," ",1)=U_SCPER_U_"NODATE" Q
. . . . ; Get EOC date and verify that it is later than Patient Effective Date
. . . . I SERVDT'>EXEMPTDT Q
. . . . S DSTATUS=$S(DSTATUS="CANCELLATION":"ARCXLD",DSTATUS="COLLECTED/CLOSED":"C/C",1:DSTATUS)
. . . . S ^TMP($J,"RCDMCR7","DETAIL",NAME,SSN,BILLNO,IBCNT)=SERVDT_U_SCPER_U_EXEMPTDT_U_DSTATUS
K ^TMP($J,"RCDMCR7","ARIB")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDMCR7B 5320 printed Sep 23, 2025@19:19:43 Page 2
RCDMCR7B ;ALB/YG - 10-40% SC Medical Care Copayment Exempt Charge Reconciliation Report - Collect Data ;Apr 9, 2019@21:06
+1 ;;4.5;Accounts Receivable;**347**;Jan 29, 2019;Build 47
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; See RCDMCR7A for detailed description
+5 ;
COLLECT(STOPIT,ARTYPE) ; Get the report data
+1 ;Input
+2 ; STOPIT - Passed Variable to determine if process is to be terminated
+3 ; ARTYPE - AR Type 1:Active;2:Open;3:Suspended;4:Collected/Closed;5:On-Hold;6:Write Off;7:All
+4 ;Output
+5 ; STOPIT - Passed Variable set to 1 if process is to be terminated
+6 ; ^TMP($J,"RCDMCR7") with report data and summary data
+7 ;N RCDFN,DEBTOR,ARIEN,IBIEN,CTR,EOCOK,IBCNT,EOCDT,DFN,DMCELIG,EFFDT,NAME,SSN
+8 ;N STATUS,OPTDT,DISCHDT,RXDT,OPTDT,RXDT,CHGAMT,OCC,BILLNO,RXNUM,RXNAM,DSTATUS,IBDATA
+9 ;Get Rated Disability Data within passed RD change time frame
+10 ;*** call API to get all RD change data for given date period
+11 NEW ZR,DEBTPT,WZH,DEBTCNT,DEBTOR,RCDFN,DFN,EXEMPTDT,SZH,VAERR,VADM,ARIEN,CTR
+12 NEW BILLNO,IBDATA,IBCNT,IBIEN,NAME,SSN,OUT,STATUS,VAEL,SCPER
+13 SET DEBTPT=0
SET WZH=$HOROLOG*86400+$PIECE($HOROLOG,",",2)+60
SET SZH=WZH
WRITE !
+14 KILL ^TMP($JOB,"RCDMCR7","ARIB")
+15 FOR DEBTCNT=0:1
SET DEBTPT=$ORDER(^RCD(340,"B",DEBTPT))
if DEBTPT=""
QUIT
IF DEBTPT[";DPT("
Begin DoDot:1
+16 ;Get AR Debtor info from file 340
+17 SET DEBTOR=0
SET RCDFN=$PIECE(DEBTPT,";")
+18 FOR
SET DEBTOR=$ORDER(^RCD(340,"B",DEBTPT,DEBTOR))
if DEBTOR'>0
QUIT
Begin DoDot:2
+19 SET DFN=RCDFN
+20 ;Get Eligibility Data
+21 DO ELIG^VADPT
+22 ;Quit if ^DPT(DFN,0) not defined
+23 if $GET(VAERR)>0
QUIT
+24 ;Get monetary benefit data
+25 DO MB^VADPT
+26 ;SERVICE CONNECTED?
+27 SET SCPER=$PIECE($GET(VAEL(3)),U,2)
+28 IF SCPER<10!(SCPER>49)
QUIT
+29 SET EXEMPTDT=$$GET1^DIQ(2,DFN_",",.3014,"I")
+30 IF DFN'>0
DO KVAR^VADPT
QUIT
+31 DO DEM^VADPT
+32 IF $GET(VAERR)>0
DO KVAR^VADPT
QUIT
+33 SET NAME=$GET(VADM(1))
+34 IF NAME']""
DO KVAR^VADPT
QUIT
+35 SET SSN=$PIECE(VADM(2),U,1)
+36 DO KVAR^VADPT
+37 ;I EXEMPTDT="" S ^TMP($J,"RCDMCR6","DETAIL",NAME,SSN," ",1)=U_U_U_"NODATE" Q
+38 ;Get AR Bill Data that is within the last BEGDT time period
+39 ;for Bill's with a current status of ACTIVE, OPEN, SUSPENDED, WRITE-OFF, COLLECTED/CLOSED, or IB Status of ON-HOLD
+40 KILL ^TMP($JOB,"RCDMCR7","ARIB")
+41 IF $HOROLOG*86400+$PIECE($HOROLOG,",",2)>WZH
SET WZH=$HOROLOG*86400+$PIECE($HOROLOG,",",2)+30
SET $X=0
WRITE *13,$FNUMBER(DEBTCNT*100/$PIECE(^RCD(340,0),U,4),",",2),"% done in ",WZH-SZH," seconds"
+42 SET ARIEN=0
+43 IF ARTYPE'=5
FOR
SET ARIEN=$ORDER(^PRCA(430,"C",DEBTOR,ARIEN))
if 'ARIEN
QUIT
Begin DoDot:3
+44 ;Counter
SET CTR=$GET(CTR)+1
+45 IF CTR#500=0
SET STOPIT=$$STOPIT^RCDMCUT2()
IF STOPIT
QUIT
+46 SET BILLNO=$$GET1^DIQ(430,ARIEN_",",.01)
+47 IF BILLNO']""
QUIT
+48 ; only look at 1st party bills - TBD
+49 IF '$$FIRSTPAR^RCDMCUT1(ARIEN)
QUIT
+50 ;IEN is from calling routine (for file 430)
+51 SET STATUS=$$GET1^DIQ(430,ARIEN_",",8,"E")
+52 IF ARTYPE=1
IF STATUS'="ACTIVE"
QUIT
+53 IF ARTYPE=2
IF STATUS'="OPEN"
QUIT
+54 IF ARTYPE=3
IF STATUS'="SUSPENDED"
QUIT
+55 IF ARTYPE=4
IF STATUS'="COLLECTED/CLOSED"
QUIT
+56 IF ARTYPE=6
IF STATUS'="WRITE-OFF"
QUIT
+57 IF ARTYPE=7
IF "^ACTIVE^OPEN^SUSPENDED^WRITE-OFF^COLLECTED/CLOSED^CANCELLATION^"'[(U_STATUS_U)
QUIT
+58 ;S SERDT=$$GETIB(BILLNO,.IBDATA)
+59 KILL IBDATA
SET IBDATA=0
+60 SET IBIEN=""
+61 FOR
SET IBIEN=$ORDER(^IB("ABIL",BILLNO,IBIEN))
if 'IBIEN
QUIT
Begin DoDot:4
+62 SET OUT=$$GETIB^RCDMCR4B(IBIEN,0)
+63 IF OUT
IF $PIECE(OUT,U,5)'=10
if $PIECE(OUT,U,1,2)'=U
SET IBDATA=IBDATA+1
SET IBDATA(IBDATA)=OUT
End DoDot:4
+64 IF 'IBDATA
QUIT
+65 MERGE ^TMP($JOB,"RCDMCR7","ARIB",BILLNO,"IBDATA")=IBDATA
+66 SET ^TMP($JOB,"RCDMCR7","ARIB",BILLNO,"STATUS")=STATUS
End DoDot:3
if $GET(STOPIT)>0
QUIT
+67 SET IBIEN=""
+68 IF ARTYPE=5!(ARTYPE=7)
FOR
SET IBIEN=$ORDER(^IB("AH",RCDFN,IBIEN))
if IBIEN=""
QUIT
Begin DoDot:3
+69 KILL IBDATA
SET IBDATA=0
+70 ;Counter
SET CTR=$GET(CTR)+1
+71 IF CTR#500=0
SET STOPIT=$$STOPIT^RCDMCUT2()
if STOPIT
QUIT
+72 SET BILLNO="/"_IBIEN
+73 SET OUT=$$GETIB^RCDMCR4B(IBIEN,1)
+74 IF 'OUT
QUIT
+75 IF $PIECE(OUT,U,1,2)=U
QUIT
+76 SET IBDATA=1
SET IBDATA(1)=OUT
+77 MERGE ^TMP($JOB,"RCDMCR7","ARIB",BILLNO,"IBDATA")=IBDATA
+78 SET ^TMP($JOB,"RCDMCR7","ARIB",BILLNO,"STATUS")="ON HOLD"
End DoDot:3
if $GET(STOPIT)>0
QUIT
+79 SET BILLNO=""
+80 FOR
SET BILLNO=$ORDER(^TMP($JOB,"RCDMCR7","ARIB",BILLNO))
if BILLNO=""
QUIT
Begin DoDot:3
+81 KILL IBDATA
MERGE IBDATA=^TMP($JOB,"RCDMCR7","ARIB",BILLNO,"IBDATA")
+82 SET STATUS=^TMP($JOB,"RCDMCR7","ARIB",BILLNO,"STATUS")
+83 FOR IBCNT=1:1:IBDATA
Begin DoDot:4
+84 NEW DSTATUS,DISCHDT,SERVDT,OPTDT
+85 ;IBDATA - Array of 1 ^ Outpatient Date ^ Discharge Date ^ RX/Refill Date ^ IB Status ^ RX NUM ^ RX Name ^ CHGAMT
+86 SET OPTDT=$PIECE(IBDATA(IBCNT),U,2)
+87 SET DISCHDT=$PIECE(IBDATA(IBCNT),U,3)
+88 SET SERVDT=$SELECT(OPTDT>DISCHDT:OPTDT,DISCHDT>OPTDT:DISCHDT,1:"")
+89 ;S RXDT=$P(IBDATA(IBCNT),U,4)
+90 ;S IBSTATUS=$P(IBDATA(IBCNT),U,5)
+91 ;S RXNUM=$P(IBDATA(IBCNT),U,6)
+92 ;S RXNAM=$P(IBDATA(IBCNT),U,7)
+93 SET DSTATUS=STATUS
+94 ; this node will be set over and over again, but it is one node per NODATE debtor
+95 IF EXEMPTDT=""
SET ^TMP($JOB,"RCDMCR7","DETAIL",NAME,SSN," ",1)=U_SCPER_U_"NODATE"
QUIT
+96 ; Get EOC date and verify that it is later than Patient Effective Date
+97 IF SERVDT'>EXEMPTDT
QUIT
+98 SET DSTATUS=$SELECT(DSTATUS="CANCELLATION":"ARCXLD",DSTATUS="COLLECTED/CLOSED":"C/C",1:DSTATUS)
+99 SET ^TMP($JOB,"RCDMCR7","DETAIL",NAME,SSN,BILLNO,IBCNT)=SERVDT_U_SCPER_U_EXEMPTDT_U_DSTATUS
End DoDot:4
End DoDot:3
End DoDot:2
if $GET(STOPIT)>0
QUIT
End DoDot:1
+100 KILL ^TMP($JOB,"RCDMCR7","ARIB")
+101 QUIT
