source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDMCEDT.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1RCDMCEDT ;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.
4UPDTDMC ;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 ;
63EDIT(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
97EDITQ ;Used to allow a common exit and to unlock the record
98 L -^PRCA(430,DA,12.1)
99 Q
Note: See TracBrowser for help on using the repository browser.