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

RCDMCUT1.m

Go to the documentation of this file.
  1. RCDMCUT1 ;HEC/SBW - Utility Functions for Hold Debt to DMC Project ;30/AUG/2007
  1. ;;4.5;Accounts Receivable;**253,347**;Mar 20, 1995;Build 47
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. Q
  1. ;
  1. HOLDCHK(IEN,DFN) ;Check if receivable shouldn't be sent to DMC
  1. ;Dont refer receivables for veterans who are (return 1)
  1. ; 1. "DMC Debt Valid" field = NULL and
  1. ; SC 50% to 100% or in receipt of VA Pension and "DMC Debt Valid"
  1. ; For this case only update DMC Debt Valid Field to Pending
  1. ; 2. "DMC Debt Valid" is Pending or NO
  1. ;Refer receivables for veterans who are (return 0)
  1. ; 1. "DMC Debt Valid" is "YES"
  1. ; 2. "DMC Debt Valid" is NULL and
  1. ; not SC 50% to 100% and not in receipt of a VA Pensions
  1. ;
  1. ;INPUT
  1. ; IEN - Internal Entry Number for Accounts Recievable File
  1. ; DFN - Internal Entry Number to Patient (#2) file
  1. ;OUTPUT
  1. ; 1 - Don't sent the Debt to DMC
  1. ; 0 - Debt can be sent to DMC
  1. ;
  1. N OUT,DMCVALID,DMCELIG
  1. S OUT=0
  1. ;Quit if invalid IEN or DFN passed
  1. Q:$G(IEN)'>0!($G(DFN)'>0) OUT
  1. ;Get DMC Debt Valid field
  1. S DMCVALID=$$GET1^DIQ(430,+$G(IEN)_",",125,"E")
  1. ;If DMC Debt Valid is No or Pending don't refer to DMC
  1. S:DMCVALID="NO"!(DMCVALID="PENDING") OUT=1
  1. ;If DMC Debt Valid is Yes refer to DMC
  1. S:DMCVALID="YES" OUT=0
  1. ;Check if Vet is SC 50% to 100% or in Receipt of VA Pension
  1. S DMCELIG=+$$DMCELIG^RCDMCUT1(+$G(DFN))
  1. ;If DMC Debt Valid is Null & SC 50% to 100% or Receiving VA Pension
  1. ;refer to DMC
  1. D:DMCVALID=""&(DMCELIG>0)
  1. . S OUT=1
  1. . ;Update DMC Valid Indicator to Pending
  1. . D UPDTDMC^RCDMCUT1(IEN,"P",1)
  1. ;If DMC Debt Valid is Null & NOT SC 50%to100% & NOT Receiving VA Pension
  1. ;don't refer to DMC
  1. S:DMCVALID=""&(DMCELIG'>0) OUT=0
  1. Q OUT
  1. ;
  1. DMCELIG(DFN) ;Checks Bill Debtor SC% and Receipt of VA Pension Values
  1. ;INPUT:
  1. ; DFN - Pointer Value to Patient (#2) file
  1. ;OUTPUT:
  1. ; Returns 0 if not SC 50% to 100% and not receiving a VA Pension
  1. ; Returns "1^ SC % ^ VA Pension ^ A&A Benefits ^ Housbound Benefits"
  1. ; if SC 50% to 100% or Receiving a VA Pension.
  1. ; Should also consider Vets who are receiving A&A or
  1. ; Housebound benefits as Receiving VA a VA Pension.
  1. ; The 2nd piece will be the SC % if SC 50% to 100%.
  1. ; The 3rd piece will be a 1 if Receiving a VA Pension.
  1. ; If not SC 50% to 100% or Receiving a VA Pension then
  1. ; The 4th piece will be the A&A Benefits.
  1. ; The 5th piece will be the Housebound Benefits.
  1. ;
  1. N OUT
  1. ;Protect the VADPT variables to prevent errors with ^RCDMC90 routine
  1. N VAHOW,VAROOT,VAERR,VAEL,VAMB,VADM,VASV,VAPA,VATEST,VAOA,VAINDT,VAIN
  1. N VAIP,VAPD,VARP,VASD,VA,VADMVT
  1. S OUT=0
  1. ;Quit if no DFN passed
  1. Q:$G(DFN)'>0 OUT
  1. ;Get Eligibility Data
  1. D ELIG^VADPT
  1. ;Quit if ^DPT(DFN,0) not defined
  1. Q:$G(VAERR)>0 OUT
  1. ;Get monetary benefit data
  1. D MB^VADPT
  1. ;SERVICE CONNECTED? Field- If SC the SC% returned in the 2nd piece.
  1. S:$P($G(VAEL(3)),U,2)>49 $P(OUT,U,1)=1,$P(OUT,U,2)=$P(VAEL(3),U,2)
  1. ;RECEIVING A VA PENSION?
  1. S:$P($G(VAMB(4)),U,1)>0 $P(OUT,U,1)=1,$P(OUT,U,3)=$P(VAMB(4),U,1)
  1. D:+OUT'>0
  1. . ;RECEIVING A&A BENEFITS?
  1. . S:$P($G(VAMB(1)),U,1)>0 $P(OUT,U,1)=1,$P(OUT,U,4)=$P(VAMB(1),U,1)
  1. . ;RECEIVING HOUSEBOUND BENEFITS?
  1. . S:$P($G(VAMB(2)),U,1)>0 $P(OUT,U,1)=1,$P(OUT,U,5)=$P(VAMB(2),U,1)
  1. D KVAR^VADPT
  1. Q OUT
  1. ;
  1. UPDTDMC(IEN,VAL,DELBY) ;Update the DMC Debt Valid Field
  1. ;INPUT
  1. ; IEN - Internal Entry Number of Accounts Receivable (#430) file
  1. ; VAL - DMC Debt Valid Value ("P", "Y", "N" or "@"),
  1. ; If "@" pass the field will be deleted
  1. ; DELBY - Used to delete the "DMC Debt Valid Edited By" field when
  1. ; updated by the Nightly Background Job
  1. ;Output
  1. ; No output
  1. ;
  1. N DA,DIE,DR,X,Y
  1. Q:$G(IEN)'>0
  1. Q:"^Y^N^P^@^"'[(U_$G(VAL)_U)
  1. L +^PRCA(430,IEN,12.1):30
  1. ;Quit if another user is editing this entry
  1. I '$T Q
  1. S DA=IEN
  1. S DIE=430
  1. S DR="125////"_VAL
  1. S:$G(DELBY)>0 DR=DR_";126///@"
  1. D ^DIE
  1. L -^PRCA(430,IEN,12.1)
  1. Q
  1. ;
  1. GETDEM(DFN) ; Get data from Patient (#2) file
  1. ;INPUT:
  1. ; DFN - Pointer Value to Patient (#2) file
  1. ;OUTPUT:
  1. ; DEM^VADPT VADM array as spelled out in PIMS Technical Manual
  1. ;
  1. ;Calling routines needs to New or Kill following Variables by calling
  1. ; D KVAR^VADPT
  1. ; VADM,VAERR,VA
  1. ;
  1. N OUT,Y
  1. S OUT=0
  1. ;Quit if no DFN passed
  1. Q:$G(DFN)'>0 OUT
  1. ;Get Demographic Data
  1. D DEM^VADPT
  1. ;Quit if ^DPT(DFN,0) not defined
  1. Q:$G(VAERR)>0 OUT
  1. ;Calls Successful
  1. S OUT=1
  1. Q OUT
  1. ;
  1. FIRSTPAR(IEN430) ;Check if this is a First Party bill
  1. ;INPUT
  1. ; IEN430 - Internal Entry Number for Accounts Receivable File
  1. ;OUTPUT
  1. ; Returns a 0 if not First Party Bill
  1. ; Returns a 1 if First Party Bill
  1. ;
  1. N FLD,FIRST,IEN340
  1. ;Set default to zero
  1. S FIRST=0
  1. S IEN430=+$G(IEN430)
  1. ;Get DEBTOR Field Value in Account Receivable File
  1. S IEN340=+$P($G(^PRCA(430,IEN430,0)),U,9)
  1. ;If .01 field in AR Debtor File points to the Patient file
  1. ;then this is a First Party Debt
  1. S FLD=$P($G(^RCD(340,IEN340,0)),U,1)
  1. S:FLD["DPT" FIRST=1_U_$P(FLD,";",1)
  1. Q FIRST
  1. ;
  1. GETSERDT(BILLNUM) ; Get most recent Outpatient Date, Inpatient Date and RX Date
  1. ; from the IB Action (#350) file for the corresponding bill
  1. ;INPUT
  1. ; BILLNUM - Bill No. (.01) field in AR (#430) file
  1. ;OUTPUT
  1. ; 0 - No data
  1. ; 1 ^ Outpatient Date ^ Discharge Date ^ RX/Refill Date ^ Status
  1. N OUT,IEN
  1. S OUT=0,IEN=0
  1. ;Quit if a Bill Number wasn't passed
  1. Q:$G(BILLNUM)']"" OUT
  1. F S IEN=$O(^IB("ABIL",BILLNUM,IEN)) Q:IEN'>0 D
  1. . N IBDATA,IENS,DFN,ACTTYPE,RESULT,DTBILLFR,BILGROUP,OPDT,DISCHARG,RXDT,STATUS,RXNUM,RXNAM
  1. . S IENS=IEN_","
  1. . D GETS^DIQ(350,IENS,".02;.03;.04;.14","IN","IBDATA")
  1. . S DFN=$G(IBDATA(350,IENS,.02,"I"))
  1. . S ACTTYPE=$G(IBDATA(350,IENS,.03,"I"))
  1. . S RESULT=$G(IBDATA(350,IENS,.04,"I"))
  1. . S DTBILLFR=$G(IBDATA(350,IENS,.14,"I"))
  1. . S STATUS=$$GET1^DIQ(350,IENS,.05)
  1. . ;
  1. . ;Child charge. Need to get Parent Charge
  1. . I $P(RESULT,":",1)=350 D
  1. . . S IENS=+$P(RESULT,":",2)_","
  1. . . ;Quit if the entry is the parent
  1. . . Q:+IENS=IEN
  1. . . D GETS^DIQ(350,IENS,".02;.03;.04;.14","IN","IBDATA")
  1. . . S DFN=$G(IBDATA(350,IENS,.02,"I"))
  1. . . S ACTTYPE=$G(IBDATA(350,IENS,.03,"I"))
  1. . . S RESULT=$G(IBDATA(350,IENS,.04,"I"))
  1. . . S DTBILLFR=$G(IBDATA(350,IENS,.14,"I"))
  1. . . S STATUS=$$GET1^DIQ(350,IENS,.05)
  1. . Q:$G(DFN)']""
  1. . ;
  1. . ;Get Billing Group in the IB Action Type File. If internal Set
  1. . ;Code value is 4, then this is an Outpatient Visit (From STMT^IBRFN1)
  1. . ;and can use Date Billed From for the Outpatient Visit Date
  1. . S BILGROUP=$$GET1^DIQ(350.1,+ACTTYPE_",",.11,"I")
  1. . ;
  1. . ;Outpatient Event
  1. . I BILGROUP=4!($P(RESULT,":",1)=44)!($P(RESULT,":",1)=409.68) D Q
  1. . . I $P(RESULT,":",1)=44 S OPDT=$P($P(RESULT,";",2),":",2)
  1. . . I $P(RESULT,":",1)=409.68 S OPDT=$$GET1^DIQ(409.68,+$P(RESULT,":",2)_",",.01,"I")
  1. . . I $G(OPDT)'>0 S OPDT=DTBILLFR
  1. . . I $G(OPDT)>$P(OUT,U,2) S $P(OUT,U,1)=1,$P(OUT,U,2)=OPDT,$P(OUT,U,5)=STATUS
  1. . ;
  1. . ;Quit if RESULTING FROM field is blank
  1. . Q:$G(RESULT)']""
  1. . ;
  1. . ;Inpatient Event
  1. . I $P(RESULT,":",1)=405!($P(RESULT,":",1)=45) D Q
  1. . . S VAIP("E")=$P($P(RESULT,";",1),":",2)
  1. . . ;Call to get Inpatient data
  1. . . D IN5^VADPT
  1. . . Q:VAERR>0
  1. . . S DISCHARG=$P($G(VAIP(17,1)),U,1)
  1. . . ;Ensure get most current Discharge Date
  1. . . I DISCHARG>$P(OUT,U,3) S $P(OUT,U,1)=1,$P(OUT,U,3)=DISCHARG,$P(OUT,U,5)=STATUS
  1. . . D KVAR^VADPT
  1. . ;
  1. . ;RX Event
  1. . I $P(RESULT,":",1)=52 D Q
  1. . . N PSOFILE,IENS,FLD
  1. . . ;Set up for RX Refills
  1. . . I $P(RESULT,";",2)]"" D
  1. . . . S PSOFILE=52.1
  1. . . . S IENS=+$P($P(RESULT,";",2),":",2)_","_+$P($P(RESULT,";",1),":",2)_","
  1. . . . S RXDT=$$GET1^PSODI(PSOFILE,IENS,.01,"I")
  1. . . . S RXNAM="1^TBD",RXNUM="1^TBD"
  1. . . ;Set up for RX Data (No refill)
  1. . . I $P(RESULT,";",2)']"" D
  1. . . . S PSOFILE=52
  1. . . . S IENS=+$P($P(RESULT,";",1),":",2)_","
  1. . . . S RXDT=$$GET1^PSODI(PSOFILE,IENS,1,"I")
  1. . . . S RXNUM=$$GET1^PSODI(PSOFILE,IENS,.01,"I")
  1. . . . S RXNAM=$$GET1^PSODI(PSOFILE,IENS,6,"E")
  1. . . ;Ensure get most current RX/Refill Date
  1. . . I RXDT>$P(OUT,U,4) S $P(OUT,U,1)=1,$P(OUT,U,4)=$P(RXDT,U,2),$P(OUT,U,5)=STATUS,$P(OUT,U,6)=$P(RXNUM,U,2),$P(OUT,U,7)=$P(RXNAM,U,2)
  1. Q OUT
  1. ;