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