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

RCDMCR3B.m

Go to the documentation of this file. 
  1. RCDMCR3B ;HEC/SBW - DMC Rated Disability Elig Change - Collect Data ;23/OCT/2007
  1.  ;;4.5;Accounts Receivable;**253**;Mar 20, 1995;Build 9
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1. COLLECT(STOPIT,BEGDT,RDBEGDT,RDENDDT) ; Get the report data
  1.  ;Input
  1.  ;   STOPIT - Passed Variable to determine if process is to be terminated
  1.  ;   BEGDT  - Beginning Date (in past) to get Episode of Care data for.
  1.  ;            (Required)
  1.  ;   RDBEGDT - Rated Disability Change Beginning date, (Required)
  1.  ;   RDENDDT - Rated Disability Change Ending Date, (Required)
  1.  ;Output
  1.  ;   STOPIT - Passed Variable set to 1 if process is to be terminated
  1.  ;   ^TMP($J,"RCDMCR3") with report data and summary data
  1.  N RCDFN,DEBTOR,IEN,CTR
  1.  ;Quit if passed parameter variables not populated
  1.  I $G(BEGDT)'>0,$G(RDBEGDT)'>0,$G(RDENDDT)'>0 Q
  1.  ;Get Rated Disability Data within passed RD change time frame
  1.  ;*** call API to get all RD data for given date period
  1.  K ^TMP($J,"RDCHG")
  1.  D RDCHG^DGENRDUA("",RDBEGDT,RDENDDT)
  1.  S RCDFN=0
  1.  F  S RCDFN=$O(^TMP($J,"RDCHG",RCDFN)) Q:RCDFN'>0  D  Q:$G(STOPIT)>0
  1.  . ;Get AR Debtor info from file 340
  1.  . S DEBTOR=0
  1.  . F  S DEBTOR=$O(^RCD(340,"B",RCDFN_";DPT(",DEBTOR)) Q:DEBTOR'>0  D  Q:$G(STOPIT)>0
  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
  1.  . . S IEN=0
  1.  . . F  S IEN=$O(^PRCA(430,"C",DEBTOR,IEN)) Q:IEN'>0  D  Q:$G(STOPIT)>0
  1.  . . . N STATUS,BADDATA,OPTDT,DISCHDT,RXDT,NAME,SSN,SSNLF,OPTDT,RXDT
  1.  . . . N DISCHDT,OCC,BILLNO,CLOC,CNUM
  1.  . . . S CTR=$G(CTR)+1 ;Counter
  1.  . . . I CTR#500=0 S STOPIT=$$STOPIT^RCDMCUT2() Q:STOPIT
  1.  . . . ;Quit if Veteran is SC 50% to 100% or Receiving VA Pension
  1.  . . . Q:$$DMCELIG^RCDMCUT1(RCDFN)>0
  1.  . . . S STATUS=$$GET1^DIQ(430,IEN_",",8)
  1.  . . . ;Quit if Current Status is not Active, Open or Suspended
  1.  . . . Q:"^ACTIVE^OPEN^SUSPENDED^"'[(U_STATUS_U)
  1.  . . . ;Get Bill Data
  1.  . . . S BADDATA=0
  1.  . . . D GETDATA
  1.  . . . Q:$G(BADDATA)>0
  1.  . . . ;Check that Episode of Care is not older than BEGDT
  1.  . . . ;Quit if there isn't a service date in the last BEGDT days
  1.  . . . Q:OPTDT<BEGDT&(DISCHDT<BEGDT)&(RXDT<BEGDT)
  1.  . . . ;Get Rated Disability Data for this veteran.
  1.  . . . S OCC=0
  1.  . . . F  S OCC=$O(^TMP($J,"RDCHG",RCDFN,OCC)) Q:OCC'>0  D
  1.  . . . . N RDNODE,RDCHGDT,RDNAME,RDSEXTRE,RDLEXTRE,RDORGDT
  1.  . . . . S RDNODE=$G(^TMP($J,"RDCHG",RCDFN,OCC))
  1.  . . . . S RDCHGDT=$P($P(RDNODE,U,1),".",1)
  1.  . . . . S RDNAME=$P(RDNODE,U,3)
  1.  . . . . S RDSEXTRE=$P(RDNODE,U,5)
  1.  . . . . S:RDSEXTRE']"" RDSEXTRE=0
  1.  . . . . S RDLEXTRE=$P(RDNODE,U,6)
  1.  . . . . S RDORGDT=$P(RDNODE,U,7)
  1.  . . . . ;Quit if there isn't a RD Change Date or RD Name
  1.  . . . . I RDCHGDT'>0,RDNAME']"" Q
  1.  . . . . 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
  1.  . . . . ;Set total unique veterans
  1.  . . . . I $D(^TMP($J,"RCDMCR3","VETSSN",SSN))'>0 D
  1.  . . . . . S ^TMP($J,"RCDMCR3","SUM-VET")=$G(^TMP($J,"RCDMCR3","SUM-VET"))+1
  1.  . . . . . S ^TMP($J,"RCDMCR3","VETSSN",SSN)=""
  1.  . . . . ;Set total RD Changes
  1.  . . . . I $D(^TMP($J,"RCDMCR3","VETSSN",SSN,RDCHGDT,RDNAME,RDSEXTRE))'>0 D
  1.  . . . . . S ^TMP($J,"RCDMCR3","SUM-RD")=$G(^TMP($J,"RCDMCR3","SUM-RD"))+1
  1.  . . . . . S ^TMP($J,"RCDMCR3","VETSSN",SSN,RDCHGDT,RDNAME,RDSEXTRE)=""
  1.  . . . . ;Set total unique bills
  1.  . . . . I $D(^TMP($J,"RCDMCR3","VETBILL",BILLNO))'>0 D
  1.  . . . . . S ^TMP($J,"RCDMCR3","SUM-BILL")=$G(^TMP($J,"RCDMCR3","SUM-BILL"))+1
  1.  . . . . . S ^TMP($J,"RCDMCR3","VETBILL",BILLNO)=""
  1.  K ^TMP($J,"RDCHG")
  1.  Q
  1.  ;
  1. GETDATA ;Get data for report
  1.  ;Get AR Bill Data - Bill #, Patient, Current Status,
  1.  ;Principal Balance, Name SSN, Service Dates
  1.  ;Rated Disability Eligibility Data
  1.  N DFN,SERDT
  1.  S DFN=$G(RCDFN)
  1.  ;Quit if DFN not set
  1.  I DFN'>0 S BADDATA=1 Q
  1.  ;
  1.  ;IEN is from calling routine
  1.  ;Bill Number
  1.  S BILLNO=$$GET1^DIQ(430,IEN_",",.01)
  1.  I BILLNO']"" S BADDATA=1 Q
  1.  ;
  1.  ;Get Demographic Data
  1.  D DEM^VADPT
  1.  I $G(VAERR)>0 S BADDATA=1 D KVAR^VADPT Q
  1.  S NAME=$G(VADM(1))
  1.  I NAME']"" S BADDATA=1 Q
  1.  S SSN=$P(VADM(2),U,1)
  1.  S SSNLF=$G(VA("BID"))
  1.  I SSNLF']"" S BADDATA=1 Q
  1.  ;
  1.  ;Get Eligibility Data
  1.  D ELIG^VADPT
  1.  S CNUM=$G(VAEL(7))
  1.  ;If claim # same as SSN, block first 5 characters
  1.  I CNUM]"",CNUM=SSN S CNUM="#####"_$E(CNUM,6,10)
  1.  D KVAR^VADPT
  1.  ;Get Station Number in file #4 for the Claim Folder Location in file #2
  1.  I CNUM]"" D
  1.  . S CLOC=$$GET1^DIQ(4,+$$GET1^DIQ(2,DFN_",",.314,"I","","ERR")_",",99)
  1.  ;
  1.  ;Get Service Date
  1.  S SERDT=$$GETSERDT^RCDMCUT1(BILLNO)
  1.  ;Get outpatient date
  1.  S OPTDT=$P(SERDT,U,2)
  1.  ;Get Inpatient Discharge date
  1.  S DISCHDT=$P(SERDT,U,3)
  1.  ;Get RX fill/refill date
  1.  S RXDT=$P(SERDT,U,4)
  1.  Q