- RCDMCR8B ;ALB/LB - Pension Report Exempt Charge Reconciliation Report - Input/output; Jun 16, 2021@14:23
- ;;4.5;Accounts Receivable;**384**;JUN 16, 2021;Build 29
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- ; Reference to PATIENT in ICR #7277
- ; Reference to INTEGRATED BILLING ACTION in ICR #4541
- ;
- ; See RCDMCR8A 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,"RCDMCR8") with report data and summary data
- ;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,DMCELIG,ELIG,EXEMPTDT,SZH,VAEL,VAERR,VADM,ARIEN,CTR
- N BILLNO,IBDATA,IBCNT,IBIEN,NAME,SSN,OUT,STATUS,ELIGTYP,PARENT,ADMDT,RESULT,IPSTART,PNTERMDT
- S DEBTPT=0,WZH=$H*86400+$P($H,",",2)+60,SZH=WZH W !
- 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
- . . S DMCELIG=$$DMCELIG^RCDMCUT1(RCDFN)
- . . Q:'DMCELIG
- . . S ELIG=$S($P(DMCELIG,U,2)'="":"SC"_$P(DMCELIG,U,2),$P(DMCELIG,U,3)'="":"Pension",$P(DMCELIG,U,4)'="":"A&A",$P(DMCELIG,U,5)'="":"HouseBnd",1:"")
- . . Q:ELIG?1"SC".E
- . . S ELIGTYP=$S(ELIG="Pension":"PEN",ELIG="A&A":ELIG,ELIG="HouseBnd":"HSB",1:"")
- . . Q:ELIGTYP'="PEN" ; 8/11/2021 only include primary Eligibility type of Pension
- . . D ELIG^VADPT I $P(VAEL(8),U,1)'="V" Q ;Quit if Eligibility status is not Verified
- . . D KVAR^VADPT
- . . ; Business decision: For Pension use PENSION AWARD EFFECTIVE DATE, File #2 field .3851 as the ECRMPTDT
- . . I ELIGTYP="PEN" S EXEMPTDT=$$GET1^DIQ(2,DFN_",",.3851,"I") ;8/11/2021
- . . I ELIGTYP="PEN" S PNTERMDT=$$GET1^DIQ(2,DFN_",",.3853,"I") ;9/28/2021
- . . 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
- . . ;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, CANCELLATION or IB Status of ON-HOLD
- . . K ^TMP($J,"RCDMCR8","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'>0 D Q:$G(STOPIT)>0
- . . . N ARCAT
- . . . S ARCAT=$$GET1^DIQ(430,ARIEN_",",2,"E") Q:ARCAT="CC URGENT CARE"
- . . . S CTR=$G(CTR)+1 ;Counter
- . . . I CTR#500=0 S STOPIT=$$STOPIT^RCDMCUT2() Q:STOPIT
- . . . ; only look at 1st party bills
- . . . I '$$FIRSTPAR^RCDMCUT1(ARIEN) Q
- . . . ;Bill Number
- . . . S BILLNO=$$GET1^DIQ(430,ARIEN_",",.01)
- . . . I BILLNO']""!($TR(BILLNO," ","")="") Q ;This line quits if no Bill Number in AR
- . . . S STATUS=$$GET1^DIQ(430,ARIEN_",",8,"E") ; Need to check IB status from 350 for "On-Hold"
- . . . I STATUS="ACTIVE",ARTYPE'["1",ARTYPE'[7 Q
- . . . I STATUS="OPEN",ARTYPE'["2",ARTYPE'[7 Q
- . . . I STATUS="SUSPENDED",ARTYPE'["3",ARTYPE'[7 Q
- . . . I STATUS="COLLECTED/CLOSED",ARTYPE'["4",ARTYPE'[7 Q
- . . . I STATUS="WRITE-OFF",ARTYPE'["6",ARTYPE'[7 Q
- . . . I STATUS="CANCELLATION",ARTYPE'=7 Q
- . . . I ARTYPE[7,"^ACTIVE^OPEN^SUSPENDED^WRITE-OFF^COLLECTED/CLOSED^CANCELLATION^"'[(U_STATUS_U) Q
- . . . ;if ARTYPE=5 or 7 need to check IB status of "ON HOLD"
- . . . K IBDATA S IBDATA=0 S OUT=""
- . . . S IBIEN=""
- . . . F S IBIEN=$O(^IB("ABIL",BILLNO,IBIEN)) Q:'IBIEN S OUT=$$GETIB^RCDMCR8C(IBIEN,0) I OUT D
- . . . . S IPSTART=$$GETSTRT(IBIEN) S $P(OUT,U,10)=IPSTART ;Add inpatient bill start date to OUT
- . . . . I $P(OUT,U,5)'=10 S IBDATA=IBDATA+1,IBDATA(IBDATA)=OUT
- . . . . I 'IBDATA Q
- . . . . M ^TMP($J,"RCDMCR8","ARIB",BILLNO,"IBDATA")=IBDATA
- . . . . S ^TMP($J,"RCDMCR8","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^RCDMCR8C(IBIEN,1) Q:'OUT I OUT D
- . . . . S IPSTART=$$GETSTRT(IBIEN) S $P(OUT,U,10)=IPSTART ;Add inpatient bill start date to OUT
- . . . S IBDATA=1,IBDATA(1)=OUT
- . . . M ^TMP($J,"RCDMCR8","ARIB",BILLNO,"IBDATA")=IBDATA
- . . . S ^TMP($J,"RCDMCR8","ARIB",BILLNO,"STATUS")="ON HOLD"
- . . S BILLNO=""
- . . F S BILLNO=$O(^TMP($J,"RCDMCR8","ARIB",BILLNO)) Q:BILLNO="" D ;Quits if no billno number eliminating IB that have not been billed
- . . . K IBDATA M IBDATA=^TMP($J,"RCDMCR8","ARIB",BILLNO,"IBDATA")
- . . . S STATUS=^TMP($J,"RCDMCR8","ARIB",BILLNO,"STATUS")
- . . . F IBCNT=1:1:IBDATA D
- . . . . N OPTDT,DISCHDT,SERVDT,RXDT,RXNUM,RXNAM,DSTATUS,EOCDT,IPFRMDT
- . . . . ;IBDATA - Array of 1 ^ Outpatient Date ^ Discharge Date ^ RX/Refill Date ^ IB Status ^ RX NUM ^ RX Name ^ CHGAMT^^In Patient Date Billed From
- . . . . S OPTDT=$P(IBDATA(IBCNT),U,2)
- . . . . S DISCHDT=$P(IBDATA(IBCNT),U,3)
- . . . . S IPFRMDT=$P(IBDATA(IBCNT),U,10)
- . . . . S SERVDT=$S(IPFRMDT'="":IPFRMDT,OPTDT'="":OPTDT,1:"")
- . . . . S RXDT=$P(IBDATA(IBCNT),U,4)
- . . . . S RXNUM=$P(IBDATA(IBCNT),U,6)
- . . . . S RXNAM=$P(IBDATA(IBCNT),U,7)
- . . . . S DSTATUS=STATUS
- . . . . ; Get EOC date and verify that it is later than Patient Effective Date
- . . . . S EOCDT=""
- . . . . I OPTDT>EOCDT S EOCDT=OPTDT
- . . . . I DISCHDT>EOCDT S EOCDT=DISCHDT
- . . . . I RXDT>EOCDT S EOCDT=RXDT
- . . . . I EXEMPTDT="" S ^TMP($J,"RCDMCR8","DETAIL",NAME,SSN," ",1)=U_U_ELIG_U_"NODATE"_U_U_U_U_ELIGTYP Q
- . . . . S EOCDT=EOCDT\1
- . . . . I EOCDT<EXEMPTDT Q
- . . . . S DSTATUS=$S(DSTATUS="CANCELLATION":"ARCXLD",DSTATUS="COLLECTED/CLOSED":"C/C",1:DSTATUS)
- . . . . S ^TMP($J,"RCDMCR8","DETAIL",NAME,SSN,BILLNO,IBCNT)=SERVDT_U_RXDT_U_ELIG_U_EXEMPTDT_U_RXNUM_U_RXNAM_U_DSTATUS_U_ELIGTYP_U_PNTERMDT_U_IPFRMDT_U_DISCHDT
- K ^TMP($J,"RCDMCR8","ARIB")
- Q
- ;
- GETSTRT(IBIEN) ; Get start date for InPatient / LTC
- N IBSDT,RESULT S IBSDT="",RESULT=""
- S RESULT=$P(^IB(IBIEN,0),U,4)
- I +RESULT=405!(+RESULT=45) S IBSDT=$$GET1^DIQ(350,IBIEN_",",.14,"I")
- Q IBSDT
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDMCR8B 6589 printed Feb 18, 2025@23:10:07 Page 2
- RCDMCR8B ;ALB/LB - Pension Report Exempt Charge Reconciliation Report - Input/output; Jun 16, 2021@14:23
- +1 ;;4.5;Accounts Receivable;**384**;JUN 16, 2021;Build 29
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ; Reference to PATIENT in ICR #7277
- +5 ; Reference to INTEGRATED BILLING ACTION in ICR #4541
- +6 ;
- +7 ; See RCDMCR8A for detailed description
- +8 ;
- 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,"RCDMCR8") with report data and summary data
- +7 ;Get Rated Disability Data within passed RD change time frame
- +8 ;*** call API to get all RD change data for given date period
- +9 NEW ZR,DEBTPT,WZH,DEBTCNT,DEBTOR,RCDFN,DFN,DMCELIG,ELIG,EXEMPTDT,SZH,VAEL,VAERR,VADM,ARIEN,CTR
- +10 NEW BILLNO,IBDATA,IBCNT,IBIEN,NAME,SSN,OUT,STATUS,ELIGTYP,PARENT,ADMDT,RESULT,IPSTART,PNTERMDT
- +11 SET DEBTPT=0
- SET WZH=$HOROLOG*86400+$PIECE($HOROLOG,",",2)+60
- SET SZH=WZH
- WRITE !
- +12 FOR DEBTCNT=0:1
- SET DEBTPT=$ORDER(^RCD(340,"B",DEBTPT))
- if DEBTPT=""
- QUIT
- IF DEBTPT[";DPT("
- Begin DoDot:1
- +13 ;Get AR Debtor info from file 340
- +14 SET DEBTOR=0
- SET RCDFN=$PIECE(DEBTPT,";")
- +15 FOR
- SET DEBTOR=$ORDER(^RCD(340,"B",DEBTPT,DEBTOR))
- if DEBTOR'>0
- QUIT
- Begin DoDot:2
- +16 SET DFN=RCDFN
- +17 SET DMCELIG=$$DMCELIG^RCDMCUT1(RCDFN)
- +18 if 'DMCELIG
- QUIT
- +19 SET ELIG=$SELECT($PIECE(DMCELIG,U,2)'="":"SC"_$PIECE(DMCELIG,U,2),$PIECE(DMCELIG,U,3)'="":"Pension",$PIECE(DMCELIG,U,4)'="":"A&A",$PIECE(DMCELIG,U,5)'="":"HouseBnd",1:"")
- +20 if ELIG?1"SC".E
- QUIT
- +21 SET ELIGTYP=$SELECT(ELIG="Pension":"PEN",ELIG="A&A":ELIG,ELIG="HouseBnd":"HSB",1:"")
- +22 ; 8/11/2021 only include primary Eligibility type of Pension
- if ELIGTYP'="PEN"
- QUIT
- +23 ;Quit if Eligibility status is not Verified
- DO ELIG^VADPT
- IF $PIECE(VAEL(8),U,1)'="V"
- QUIT
- +24 DO KVAR^VADPT
- +25 ; Business decision: For Pension use PENSION AWARD EFFECTIVE DATE, File #2 field .3851 as the ECRMPTDT
- +26 ;8/11/2021
- IF ELIGTYP="PEN"
- SET EXEMPTDT=$$GET1^DIQ(2,DFN_",",.3851,"I")
- +27 ;9/28/2021
- IF ELIGTYP="PEN"
- SET PNTERMDT=$$GET1^DIQ(2,DFN_",",.3853,"I")
- +28 IF DFN'>0
- DO KVAR^VADPT
- QUIT
- +29 DO DEM^VADPT
- +30 IF $GET(VAERR)>0
- DO KVAR^VADPT
- QUIT
- +31 SET NAME=$GET(VADM(1))
- +32 IF NAME']""
- DO KVAR^VADPT
- QUIT
- +33 SET SSN=$PIECE(VADM(2),U,1)
- +34 DO KVAR^VADPT
- +35 ;Get AR Bill Data that is within the last BEGDT time period
- +36 ;for Bill's with a current status of ACTIVE, OPEN, SUSPENDED, WRITE-OFF, COLLECTED/CLOSED, CANCELLATION or IB Status of ON-HOLD
- +37 KILL ^TMP($JOB,"RCDMCR8","ARIB")
- +38 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"
- +39 SET ARIEN=0
- +40 IF ARTYPE'=5
- FOR
- SET ARIEN=$ORDER(^PRCA(430,"C",DEBTOR,ARIEN))
- if ARIEN'>0
- QUIT
- Begin DoDot:3
- +41 NEW ARCAT
- +42 SET ARCAT=$$GET1^DIQ(430,ARIEN_",",2,"E")
- if ARCAT="CC URGENT CARE"
- QUIT
- +43 ;Counter
- SET CTR=$GET(CTR)+1
- +44 IF CTR#500=0
- SET STOPIT=$$STOPIT^RCDMCUT2()
- if STOPIT
- QUIT
- +45 ; only look at 1st party bills
- +46 IF '$$FIRSTPAR^RCDMCUT1(ARIEN)
- QUIT
- +47 ;Bill Number
- +48 SET BILLNO=$$GET1^DIQ(430,ARIEN_",",.01)
- +49 ;This line quits if no Bill Number in AR
- IF BILLNO']""!($TRANSLATE(BILLNO," ","")="")
- QUIT
- +50 ; Need to check IB status from 350 for "On-Hold"
- SET STATUS=$$GET1^DIQ(430,ARIEN_",",8,"E")
- +51 IF STATUS="ACTIVE"
- IF ARTYPE'["1"
- IF ARTYPE'[7
- QUIT
- +52 IF STATUS="OPEN"
- IF ARTYPE'["2"
- IF ARTYPE'[7
- QUIT
- +53 IF STATUS="SUSPENDED"
- IF ARTYPE'["3"
- IF ARTYPE'[7
- QUIT
- +54 IF STATUS="COLLECTED/CLOSED"
- IF ARTYPE'["4"
- IF ARTYPE'[7
- QUIT
- +55 IF STATUS="WRITE-OFF"
- IF ARTYPE'["6"
- IF ARTYPE'[7
- QUIT
- +56 IF STATUS="CANCELLATION"
- IF ARTYPE'=7
- QUIT
- +57 IF ARTYPE[7
- IF "^ACTIVE^OPEN^SUSPENDED^WRITE-OFF^COLLECTED/CLOSED^CANCELLATION^"'[(U_STATUS_U)
- QUIT
- +58 ;if ARTYPE=5 or 7 need to check IB status of "ON HOLD"
- +59 KILL IBDATA
- SET IBDATA=0
- SET OUT=""
- +60 SET IBIEN=""
- +61 FOR
- SET IBIEN=$ORDER(^IB("ABIL",BILLNO,IBIEN))
- if 'IBIEN
- QUIT
- SET OUT=$$GETIB^RCDMCR8C(IBIEN,0)
- IF OUT
- Begin DoDot:4
- +62 ;Add inpatient bill start date to OUT
- SET IPSTART=$$GETSTRT(IBIEN)
- SET $PIECE(OUT,U,10)=IPSTART
- +63 IF $PIECE(OUT,U,5)'=10
- SET IBDATA=IBDATA+1
- SET IBDATA(IBDATA)=OUT
- +64 IF 'IBDATA
- QUIT
- +65 MERGE ^TMP($JOB,"RCDMCR8","ARIB",BILLNO,"IBDATA")=IBDATA
- +66 SET ^TMP($JOB,"RCDMCR8","ARIB",BILLNO,"STATUS")=STATUS
- End DoDot:4
- 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^RCDMCR8C(IBIEN,1)
- if 'OUT
- QUIT
- IF OUT
- Begin DoDot:4
- +74 ;Add inpatient bill start date to OUT
- SET IPSTART=$$GETSTRT(IBIEN)
- SET $PIECE(OUT,U,10)=IPSTART
- End DoDot:4
- +75 SET IBDATA=1
- SET IBDATA(1)=OUT
- +76 MERGE ^TMP($JOB,"RCDMCR8","ARIB",BILLNO,"IBDATA")=IBDATA
- +77 SET ^TMP($JOB,"RCDMCR8","ARIB",BILLNO,"STATUS")="ON HOLD"
- End DoDot:3
- if $GET(STOPIT)>0
- QUIT
- +78 SET BILLNO=""
- +79 ;Quits if no billno number eliminating IB that have not been billed
- FOR
- SET BILLNO=$ORDER(^TMP($JOB,"RCDMCR8","ARIB",BILLNO))
- if BILLNO=""
- QUIT
- Begin DoDot:3
- +80 KILL IBDATA
- MERGE IBDATA=^TMP($JOB,"RCDMCR8","ARIB",BILLNO,"IBDATA")
- +81 SET STATUS=^TMP($JOB,"RCDMCR8","ARIB",BILLNO,"STATUS")
- +82 FOR IBCNT=1:1:IBDATA
- Begin DoDot:4
- +83 NEW OPTDT,DISCHDT,SERVDT,RXDT,RXNUM,RXNAM,DSTATUS,EOCDT,IPFRMDT
- +84 ;IBDATA - Array of 1 ^ Outpatient Date ^ Discharge Date ^ RX/Refill Date ^ IB Status ^ RX NUM ^ RX Name ^ CHGAMT^^In Patient Date Billed From
- +85 SET OPTDT=$PIECE(IBDATA(IBCNT),U,2)
- +86 SET DISCHDT=$PIECE(IBDATA(IBCNT),U,3)
- +87 SET IPFRMDT=$PIECE(IBDATA(IBCNT),U,10)
- +88 SET SERVDT=$SELECT(IPFRMDT'="":IPFRMDT,OPTDT'="":OPTDT,1:"")
- +89 SET RXDT=$PIECE(IBDATA(IBCNT),U,4)
- +90 SET RXNUM=$PIECE(IBDATA(IBCNT),U,6)
- +91 SET RXNAM=$PIECE(IBDATA(IBCNT),U,7)
- +92 SET DSTATUS=STATUS
- +93 ; Get EOC date and verify that it is later than Patient Effective Date
- +94 SET EOCDT=""
- +95 IF OPTDT>EOCDT
- SET EOCDT=OPTDT
- +96 IF DISCHDT>EOCDT
- SET EOCDT=DISCHDT
- +97 IF RXDT>EOCDT
- SET EOCDT=RXDT
- +98 IF EXEMPTDT=""
- SET ^TMP($JOB,"RCDMCR8","DETAIL",NAME,SSN," ",1)=U_U_ELIG_U_"NODATE"_U_U_U_U_ELIGTYP
- QUIT
- +99 SET EOCDT=EOCDT\1
- +100 IF EOCDT<EXEMPTDT
- QUIT
- +101 SET DSTATUS=$SELECT(DSTATUS="CANCELLATION":"ARCXLD",DSTATUS="COLLECTED/CLOSED":"C/C",1:DSTATUS)
- +102 SET ^TMP($JOB,"RCDMCR8","DETAIL",NAME,SSN,BILLNO,IBCNT)=SERVDT_U_RXDT_U_ELIG_U_EXEMPTDT_U_RXNUM_U_RXNAM_U_DSTATUS_U_ELIGTYP_U_PNTERMDT_U_IPFRMDT_U_DISCHDT
- End DoDot:4
- End DoDot:3
- End DoDot:2
- if $GET(STOPIT)>0
- QUIT
- End DoDot:1
- +103 KILL ^TMP($JOB,"RCDMCR8","ARIB")
- +104 QUIT
- +105 ;
- GETSTRT(IBIEN) ; Get start date for InPatient / LTC
- +1 NEW IBSDT,RESULT
- SET IBSDT=""
- SET RESULT=""
- +2 SET RESULT=$PIECE(^IB(IBIEN,0),U,4)
- +3 IF +RESULT=405!(+RESULT=45)
- SET IBSDT=$$GET1^DIQ(350,IBIEN_",",.14,"I")
- +4 QUIT IBSDT
- +5 ;