| 1 | RCDMCEDT ;HEC/SBW - Enter/Edit DMC Debt Valid Field ;26-Oct-2007
|
|---|
| 2 | ;;4.5;Accounts Receivable;**253**;Mar 20, 1995;Build 9
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | UPDTDMC ;This is the main entry to enter/edit DMC Debt Valid field in
|
|---|
| 5 | ;Accounts Receivable (#430) file
|
|---|
| 6 | N RCQUIT,DIROUT,DUOUT,DTOUT,DIRUT
|
|---|
| 7 | F D Q:$G(RCQUIT)>0!($D(DIROUT))
|
|---|
| 8 | . W !
|
|---|
| 9 | . N DIR,X,%,%X,Y,RCY,C,DFN,VAERR,VA,VADM,REFDT,BSTAT,RETVAL,FIRSTPAR
|
|---|
| 10 | . N ARDATA,DVAL,DVALDT,DVALUSER,IENS,PATIENT,SERDT
|
|---|
| 11 | . S DIR(0)="PAO^430:AEMQZ"
|
|---|
| 12 | . S DIR("A")="Select ACCOUNTS RECEIVABLE BILL NO. or PATIENT: "
|
|---|
| 13 | . D ^DIR
|
|---|
| 14 | . S:$D(DTOUT)!$D(DUOUT)!$D(DIRUT) RCQUIT=1
|
|---|
| 15 | . Q:+Y'>0
|
|---|
| 16 | . S RCY=Y
|
|---|
| 17 | . S RCY(0)=Y(0)
|
|---|
| 18 | . ;Get and Display info on Bill
|
|---|
| 19 | . ;Get Patient from 430 file
|
|---|
| 20 | . S PATIENT=+$P(RCY(0),U,7)
|
|---|
| 21 | . S FIRSTPAR=$$FIRSTPAR^RCDMCUT1(+RCY)
|
|---|
| 22 | . ;If Patient not in 430 file and this is a First Party bill get
|
|---|
| 23 | . ;Debtor from 350 File
|
|---|
| 24 | . S:PATIENT'>0&(+FIRSTPAR>0) PATIENT=+$P(FIRSTPAR,U,2)
|
|---|
| 25 | . I +$$GETDEM^RCDMCUT1(PATIENT)'>0 W !!," Bill doesn't have an associated Patient.",! Q
|
|---|
| 26 | . W !!,"Veteran's Name:",?17,$G(VADM(1)),!
|
|---|
| 27 | . W "Veteran's SSN:",?17,$G(VA("PID")),!
|
|---|
| 28 | . D KVAR^VADPT
|
|---|
| 29 | . I +FIRSTPAR'>0 W !," Only First Party bills can be edited.",! Q
|
|---|
| 30 | . ;Get AR Bill Data
|
|---|
| 31 | . S IENS=+$P(RCY,U,1)_","
|
|---|
| 32 | . D GETS^DIQ(430,IENS,"2;8;121;125:127","EIN","ARDATA","ERR")
|
|---|
| 33 | . ;
|
|---|
| 34 | . W "Category Type:",?17,$G(ARDATA(430,IENS,2,"E")),!
|
|---|
| 35 | . S BSTAT=$G(ARDATA(430,IENS,8,"E"))
|
|---|
| 36 | . W "Bill Status: ",?17,BSTAT,!
|
|---|
| 37 | . I "^ACTIVE^OPEN^SUSPENDED^"'[(U_BSTAT_U) D Q
|
|---|
| 38 | . . W !?5," Only Open, Active & Suspended bills may be edited.",!
|
|---|
| 39 | . S REFDT=$G(ARDATA(430,IENS,121,"E"))
|
|---|
| 40 | . I REFDT]"" W !,"Bill already referred to DMC on ",REFDT,!
|
|---|
| 41 | . ;Date of Service from file 340
|
|---|
| 42 | . S SERDT=$$GETSERDT^RCDMCUT1($P(RCY(0),U,1))
|
|---|
| 43 | . I SERDT>0 D
|
|---|
| 44 | . . W !
|
|---|
| 45 | . . I $P(SERDT,U,2) W "Outpatient Date: ",$$FMTE^XLFDT($P(SERDT,U,2),"1P"),!
|
|---|
| 46 | . . I $P(SERDT,U,3) W "Discharge Date: ",$$FMTE^XLFDT($P(SERDT,U,3),"1P"),1
|
|---|
| 47 | . . I $P(SERDT,U,4) W "RX/Refill Date: ",$$FMTE^XLFDT($P(SERDT,U,4),"1P"),!
|
|---|
| 48 | . ;Displays User Edits
|
|---|
| 49 | . S DVAL=$G(ARDATA(430,IENS,125,"E"))
|
|---|
| 50 | . S DVALUSER=$G(ARDATA(430,IENS,126,"E"))
|
|---|
| 51 | . S DVALDT=$G(ARDATA(430,IENS,127,"E"))
|
|---|
| 52 | . I DVAL]"" D
|
|---|
| 53 | . . W !,"DMC Debt Valid: ",?17,DVAL
|
|---|
| 54 | . . I DVAL="PENDING" W " DMC Debt referral stopped on ",DVALDT,!
|
|---|
| 55 | . . I DVAL="YES"!(DVAL="NO") W " Updated by ",DVALUSER," on ",DVALDT,!
|
|---|
| 56 | . ;
|
|---|
| 57 | . D EDIT(+RCY,.RETVAL)
|
|---|
| 58 | . I $G(RETVAL)="Y" W !!," Debt may be referred to DMC if it meets existing DMC referral criteria.",!
|
|---|
| 59 | . I $G(RETVAL)="N" W !!," Please cancel this bill and/or refund payment if appropriate.",!
|
|---|
| 60 | . S:$D(DTOUT)!$D(DUOUT)!$D(DIRUT) RCQUIT=1
|
|---|
| 61 | Q
|
|---|
| 62 | ;
|
|---|
| 63 | EDIT(DA,RETVAL) ;Allows user to enter/edit DMC Debt Valid Field
|
|---|
| 64 | ;INPUT
|
|---|
| 65 | ; DA - Internal Entry Number for Accounts Receivable (#430) file,
|
|---|
| 66 | ; Required variable.
|
|---|
| 67 | ;OUTPUT
|
|---|
| 68 | ; RETVAL - The value entered by the users
|
|---|
| 69 | N DIE,DR,DTOUT,DUOUT,DIRUT,DIR,X,Y
|
|---|
| 70 | S RETVAL=0
|
|---|
| 71 | Q:+$G(DA)'>0
|
|---|
| 72 | ;
|
|---|
| 73 | L +^PRCA(430,DA,12.1):10
|
|---|
| 74 | I '$T D Q
|
|---|
| 75 | .W !!?5,"Another user is editing this entry. Try later."
|
|---|
| 76 | ;
|
|---|
| 77 | ;Use DIR to get users response for the update
|
|---|
| 78 | S DIR(0)="430,125^^"
|
|---|
| 79 | S DIR("A")="Please confirm this is a valid debt based on eligibility"
|
|---|
| 80 | S DIR("B")=$P($G(^PRCA(430,DA,12.1)),U,1)
|
|---|
| 81 | D ^DIR
|
|---|
| 82 | ;Deletions and changes to Pending are not allowed
|
|---|
| 83 | I $G(X)="@",Y="" D G EDITQ
|
|---|
| 84 | . W !!," *** Deletions not allowed. ***",!
|
|---|
| 85 | I $E(Y,1)="P" D G EDITQ
|
|---|
| 86 | . W !!," *** PENDING is reserved for nightly DMC job. ***",!
|
|---|
| 87 | I DIR("B")=$E(Y,1) D G EDITQ
|
|---|
| 88 | . W !!," *** No change entered. Field not updated. ***",!
|
|---|
| 89 | ;Quit if the user times or up arrows out
|
|---|
| 90 | G:$D(DIRUT) EDITQ
|
|---|
| 91 | S RETVAL=$E(Y,1)
|
|---|
| 92 | ;
|
|---|
| 93 | ;Update the entry with the Users response of Yes or No
|
|---|
| 94 | S DIE=430
|
|---|
| 95 | S DR="125////"_$E($G(Y),1)
|
|---|
| 96 | D ^DIE
|
|---|
| 97 | EDITQ ;Used to allow a common exit and to unlock the record
|
|---|
| 98 | L -^PRCA(430,DA,12.1)
|
|---|
| 99 | Q
|
|---|
