Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCDMCR6B

RCDMCR6B.m

Go to the documentation of this file. 
  1. RCDMCR6B ;ALB/YG - 50-100 Percent SC Exempt Charge Reconciliation Report - Input/output; Apr 9, 2019@21:06
  1.  ;;4.5;Accounts Receivable;**347**;Mar 20, 1995;Build 47
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; See RCDMCR6A for detailed description
  1.  ;
  1. COLLECT(STOPIT,ARTYPE) ; Get the report data
  1.  ;Input
  1.  ;   STOPIT - Passed Variable to determine if process is to be terminated
  1.  ;   ARTYPE - AR Type  1:Active;2:Open;3:Suspended;4:Collected/Closed;5:On-Hold;6:Write Off;7:All
  1.  ;Output
  1.  ;   STOPIT - Passed Variable set to 1 if process is to be terminated
  1.  ;   ^TMP($J,"RCDMCR6") with report data and summary data
  1.  ;N RCDFN,DEBTOR,ARIEN,IBIEN,CTR,EOCOK,IBCNT,EOCDT,DFN,DMCELIG,EFFDT,NAME,SSN
  1.  ;N STATUS,OPTDT,DISCHDT,RXDT,OPTDT,RXDT,CHGAMT,OCC,BILLNO,RXNUM,RXNAM,DSTATUS,IBDATA
  1.  ;Get Rated Disability Data within passed RD change time frame
  1.  ;*** call API to get all RD change data for given date period
  1.  N ZR,DEBTPT,WZH,DEBTCNT,DEBTOR,RCDFN,DFN,DMCELIG,ELIG,EXEMPTDT,SZH,VAERR,VADM,ARIEN,CTR
  1.  N BILLNO,IBDATA,IBCNT,IBIEN,NAME,SSN,OUT,STATUS
  1.  S DEBTPT=0,WZH=$H*86400+$P($H,",",2)+60,SZH=WZH W !
  1.  F DEBTCNT=0:1 S DEBTPT=$O(^RCD(340,"B",DEBTPT)) Q:DEBTPT=""  I DEBTPT[";DPT(" D
  1.  . ;Get AR Debtor info from file 340
  1.  . S DEBTOR=0,RCDFN=$P(DEBTPT,";")
  1.  . F  S DEBTOR=$O(^RCD(340,"B",DEBTPT,DEBTOR)) Q:DEBTOR'>0  D  Q:$G(STOPIT)>0
  1.  . . S DFN=RCDFN
  1.  . . S DMCELIG=$$DMCELIG^RCDMCUT1(RCDFN)
  1.  . . Q:'DMCELIG
  1.  . . 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:"")
  1.  . . ; business decision for now is to only show SC%.  A&A, Pension and HB are off the report.
  1.  . . Q:ELIG'?1"SC".E
  1.  . . ; business decision is to change from .3012 (SC AWARD DATE) to .3014 (EFF. DATE COMBINED SC% EVAL.)
  1.  . . S EXEMPTDT=$$GET1^DIQ(2,DFN_",",.3014,"I")
  1.  . . I DFN'>0 D KVAR^VADPT Q
  1.  . . D DEM^VADPT
  1.  . . I $G(VAERR)>0 D KVAR^VADPT Q
  1.  . . S NAME=$G(VADM(1))
  1.  . . I NAME']"" D KVAR^VADPT Q
  1.  . . S SSN=$P(VADM(2),U,1)
  1.  . . D KVAR^VADPT
  1.  . . ;I EXEMPTDT="" S ^TMP($J,"RCDMCR6","DETAIL",NAME,SSN," ",1)=U_U_U_"NODATE" Q
  1.  . . ;Get AR Bill Data that is within the last BEGDT time period
  1.  . . ;for Bill's with a current status of ACTIVE, OPEN, SUSPENDED, WRITE-OFF, COLLECTED/CLOSED, CANCELLATION or IB Status of ON-HOLD
  1.  . . K ^TMP($J,"RCDMCR6","ARIB")
  1.  . . 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"
  1.  . . S ARIEN=0
  1.  . . I ARTYPE'=5 F  S ARIEN=$O(^PRCA(430,"C",DEBTOR,ARIEN)) Q:ARIEN'>0  D  Q:$G(STOPIT)>0
  1.  . . . S CTR=$G(CTR)+1 ;Counter
  1.  . . . I CTR#500=0 S STOPIT=$$STOPIT^RCDMCUT2() Q:STOPIT
  1.  . . . ; only look at 1st party bills - TBD
  1.  . . . I '$$FIRSTPAR^RCDMCUT1(ARIEN) Q
  1.  . . . ;IEN is from calling routine (for file 430)
  1.  . . . ;Bill Number
  1.  . . . S BILLNO=$$GET1^DIQ(430,ARIEN_",",.01)
  1.  . . . I BILLNO']"" Q
  1.  . . . S STATUS=$$GET1^DIQ(430,ARIEN_",",8,"E")
  1.  . . . I ARTYPE=1,STATUS'="ACTIVE" Q
  1.  . . . I ARTYPE=2,STATUS'="OPEN" Q
  1.  . . . I ARTYPE=3,STATUS'="SUSPENDED" Q
  1.  . . . I ARTYPE=4,STATUS'="COLLECTED/CLOSED" Q
  1.  . . . I ARTYPE=6,STATUS'="WRITE-OFF" Q
  1.  . . . I ARTYPE=7,"^ACTIVE^OPEN^SUSPENDED^WRITE-OFF^COLLECTED/CLOSED^CANCELLATION^"'[(U_STATUS_U) Q
  1.  . . . K IBDATA S IBDATA=0
  1.  . . . S IBIEN=""
  1.  . . . F  S IBIEN=$O(^IB("ABIL",BILLNO,IBIEN)) Q:'IBIEN  S OUT=$$GETIB^RCDMCR4B(IBIEN,0) I OUT,$P(OUT,U,5)'=10 S IBDATA=IBDATA+1,IBDATA(IBDATA)=OUT
  1.  . . . I 'IBDATA Q
  1.  . . . M ^TMP($J,"RCDMCR6","ARIB",BILLNO,"IBDATA")=IBDATA
  1.  . . . S ^TMP($J,"RCDMCR6","ARIB",BILLNO,"STATUS")=STATUS
  1.  . . S IBIEN=""
  1.  . . I ARTYPE=5!(ARTYPE=7) F  S IBIEN=$O(^IB("AH",RCDFN,IBIEN)) Q:IBIEN=""  D  Q:$G(STOPIT)>0
  1.  . . . K IBDATA S IBDATA=0
  1.  . . . S CTR=$G(CTR)+1 ;Counter
  1.  . . . I CTR#500=0 S STOPIT=$$STOPIT^RCDMCUT2() Q:STOPIT
  1.  . . . S BILLNO="/"_IBIEN
  1.  . . . S OUT=$$GETIB^RCDMCR4B(IBIEN,1) Q:'OUT
  1.  . . . S IBDATA=1,IBDATA(1)=OUT
  1.  . . . M ^TMP($J,"RCDMCR6","ARIB",BILLNO,"IBDATA")=IBDATA
  1.  . . . S ^TMP($J,"RCDMCR6","ARIB",BILLNO,"STATUS")="ON HOLD"
  1.  . . S BILLNO=""
  1.  . . F  S BILLNO=$O(^TMP($J,"RCDMCR6","ARIB",BILLNO)) Q:BILLNO=""  D
  1.  . . . K IBDATA M IBDATA=^TMP($J,"RCDMCR6","ARIB",BILLNO,"IBDATA")
  1.  . . . S STATUS=^TMP($J,"RCDMCR6","ARIB",BILLNO,"STATUS")
  1.  . . . F IBCNT=1:1:IBDATA D
  1.  . . . . N OPTDT,DISCHDT,SERVDT,RXDT,RXNUM,RXNAM,DSTATUS,EOCDT
  1.  . . . . ;IBDATA - Array of 1 ^ Outpatient Date ^ Discharge Date ^ RX/Refill Date ^ IB Status ^ RX NUM ^ RX Name ^ CHGAMT
  1.  . . . . S OPTDT=$P(IBDATA(IBCNT),U,2)
  1.  . . . . S DISCHDT=$P(IBDATA(IBCNT),U,3)
  1.  . . . . S SERVDT=$S(OPTDT>DISCHDT:OPTDT,DISCHDT>OPTDT:DISCHDT,1:"")
  1.  . . . . S RXDT=$P(IBDATA(IBCNT),U,4)
  1.  . . . . ;S IBSTATUS=$P(IBDATA(IBCNT),U,5)
  1.  . . . . S RXNUM=$P(IBDATA(IBCNT),U,6)
  1.  . . . . S RXNAM=$P(IBDATA(IBCNT),U,7)
  1.  . . . . S DSTATUS=STATUS
  1.  . . . . ; Get EOC date and verify that it is later than Patient Effective Date
  1.  . . . . S EOCDT=""
  1.  . . . . I OPTDT>EOCDT S EOCDT=OPTDT
  1.  . . . . I DISCHDT>EOCDT S EOCDT=DISCHDT
  1.  . . . . I RXDT>EOCDT S EOCDT=RXDT
  1.  . . . . I EXEMPTDT="" S ^TMP($J,"RCDMCR6","DETAIL",NAME,SSN," ",1)=U_U_ELIG_U_"NODATE" Q
  1.  . . . . I EOCDT'>EXEMPTDT Q
  1.  . . . . S DSTATUS=$S(DSTATUS="CANCELLATION":"ARCXLD",DSTATUS="COLLECTED/CLOSED":"C/C",1:DSTATUS)
  1.  . . . . S ^TMP($J,"RCDMCR6","DETAIL",NAME,SSN,BILLNO,IBCNT)=SERVDT_U_RXDT_U_ELIG_U_EXEMPTDT_U_RXNUM_U_RXNAM_U_DSTATUS
  1.  K ^TMP($J,"RCDMCR6","ARIB")
  1.  Q