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