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

RCDMCEDT.m

Go to the documentation of this file. 
  1. RCDMCEDT ;HEC/SBW - Enter/Edit DMC Debt Valid Field ;26-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. UPDTDMC ;This is the main entry to enter/edit DMC Debt Valid field in 
  1.  ;Accounts Receivable (#430) file
  1.  N RCQUIT,DIROUT,DUOUT,DTOUT,DIRUT
  1.  F  D  Q:$G(RCQUIT)>0!($D(DIROUT))
  1.  . W !
  1.  . N DIR,X,%,%X,Y,RCY,C,DFN,VAERR,VA,VADM,REFDT,BSTAT,RETVAL,FIRSTPAR
  1.  . N ARDATA,DVAL,DVALDT,DVALUSER,IENS,PATIENT,SERDT
  1.  . S DIR(0)="PAO^430:AEMQZ"
  1.  . S DIR("A")="Select ACCOUNTS RECEIVABLE BILL NO. or PATIENT: "
  1.  . D ^DIR
  1.  . S:$D(DTOUT)!$D(DUOUT)!$D(DIRUT) RCQUIT=1
  1.  . Q:+Y'>0
  1.  . S RCY=Y
  1.  . S RCY(0)=Y(0)
  1.  . ;Get and Display info on Bill
  1.  . ;Get Patient from 430 file
  1.  . S PATIENT=+$P(RCY(0),U,7)
  1.  . S FIRSTPAR=$$FIRSTPAR^RCDMCUT1(+RCY)
  1.  . ;If Patient not in 430 file and this is a First Party bill get 
  1.  . ;Debtor from 350 File
  1.  . S:PATIENT'>0&(+FIRSTPAR>0) PATIENT=+$P(FIRSTPAR,U,2)
  1.  . I +$$GETDEM^RCDMCUT1(PATIENT)'>0 W !!,"  Bill doesn't have an associated Patient.",! Q
  1.  . W !!,"Veteran's Name:",?17,$G(VADM(1)),!
  1.  . W "Veteran's SSN:",?17,$G(VA("PID")),!
  1.  . D KVAR^VADPT
  1.  . I +FIRSTPAR'>0 W !,"  Only First Party bills can be edited.",! Q
  1.  . ;Get AR Bill Data
  1.  . S IENS=+$P(RCY,U,1)_","
  1.  . D GETS^DIQ(430,IENS,"2;8;121;125:127","EIN","ARDATA","ERR")
  1.  . ;
  1.  . W "Category Type:",?17,$G(ARDATA(430,IENS,2,"E")),!
  1.  . S BSTAT=$G(ARDATA(430,IENS,8,"E"))
  1.  . W "Bill Status: ",?17,BSTAT,!
  1.  . I "^ACTIVE^OPEN^SUSPENDED^"'[(U_BSTAT_U) D  Q
  1.  . . W !?5,"  Only Open, Active & Suspended bills may be edited.",!
  1.  . S REFDT=$G(ARDATA(430,IENS,121,"E"))
  1.  . I REFDT]"" W !,"Bill already referred to DMC on ",REFDT,!
  1.  . ;Date of Service from file 340
  1.  . S SERDT=$$GETSERDT^RCDMCUT1($P(RCY(0),U,1))
  1.  . I SERDT>0 D
  1.  . . W !
  1.  . . I $P(SERDT,U,2) W "Outpatient Date: ",$$FMTE^XLFDT($P(SERDT,U,2),"1P"),!
  1.  . . I $P(SERDT,U,3) W "Discharge Date:  ",$$FMTE^XLFDT($P(SERDT,U,3),"1P"),1
  1.  . . I $P(SERDT,U,4) W "RX/Refill Date:  ",$$FMTE^XLFDT($P(SERDT,U,4),"1P"),!
  1.  . ;Displays User Edits
  1.  . S DVAL=$G(ARDATA(430,IENS,125,"E"))
  1.  . S DVALUSER=$G(ARDATA(430,IENS,126,"E"))
  1.  . S DVALDT=$G(ARDATA(430,IENS,127,"E"))
  1.  . I DVAL]"" D
  1.  . . W !,"DMC Debt Valid: ",?17,DVAL
  1.  . . I DVAL="PENDING" W "  DMC Debt referral stopped on ",DVALDT,!
  1.  . . I DVAL="YES"!(DVAL="NO") W "   Updated by ",DVALUSER," on ",DVALDT,!
  1.  . ;
  1.  . D EDIT(+RCY,.RETVAL)
  1.  . I $G(RETVAL)="Y" W !!,"  Debt may be referred to DMC if it meets existing DMC referral criteria.",!
  1.  . I $G(RETVAL)="N" W !!,"  Please cancel this bill and/or refund payment if appropriate.",!
  1.  . S:$D(DTOUT)!$D(DUOUT)!$D(DIRUT) RCQUIT=1
  1.  Q
  1.  ;
  1. EDIT(DA,RETVAL) ;Allows user to enter/edit DMC Debt Valid Field
  1.  ;INPUT
  1.  ;  DA - Internal Entry Number for Accounts Receivable (#430) file, 
  1.  ;        Required variable.
  1.  ;OUTPUT
  1.  ;  RETVAL - The value entered by the users
  1.  N DIE,DR,DTOUT,DUOUT,DIRUT,DIR,X,Y
  1.  S RETVAL=0
  1.  Q:+$G(DA)'>0
  1.  ;
  1.  L +^PRCA(430,DA,12.1):10
  1.  I '$T D  Q
  1.  .W !!?5,"Another user is editing this entry. Try later."
  1.  ;
  1.  ;Use DIR to get users response for the update
  1.  S DIR(0)="430,125^^"
  1.  S DIR("A")="Please confirm this is a valid debt based on eligibility"
  1.  S DIR("B")=$P($G(^PRCA(430,DA,12.1)),U,1)
  1.  D ^DIR
  1.  ;Deletions and changes to Pending are not allowed
  1.  I $G(X)="@",Y="" D  G EDITQ
  1.  . W !!,"   *** Deletions not allowed. ***",!
  1.  I $E(Y,1)="P" D  G EDITQ
  1.  . W !!,"   *** PENDING is reserved for nightly DMC job. ***",!
  1.  I DIR("B")=$E(Y,1) D  G EDITQ
  1.  . W !!,"   *** No change entered. Field not updated. ***",!
  1.  ;Quit if the user times or up arrows out
  1.  G:$D(DIRUT) EDITQ
  1.  S RETVAL=$E(Y,1)
  1.  ;
  1.  ;Update the entry with the Users response of Yes or No
  1.  S DIE=430
  1.  S DR="125////"_$E($G(Y),1)
  1.  D ^DIE
  1. EDITQ ;Used to allow a common exit and to unlock the record
  1.  L -^PRCA(430,DA,12.1)
  1.  Q