source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPAPLM.m@ 949

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

initial load of WorldVistAEHR
File size: 4.1 KB
Line 
1RCDPAPLM ;WISC/RFJ-account profile top list manager routine ;1 Jun 99
2 ;;4.5;Accounts Receivable;**114**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 N RCDPFXIT
6 ;
7ACCTPROF ; this entry point called by link payment to prevent newing
8 ; the fast exit variable RCDPFXIT
9 N RCDEBTDA
10 ;
11 ; check to see if user has any selected status's to display,
12 ; if not, set up the default status's
13 I $G(^DISV(DUZ,"RCDPAPLM","STATUS"))="" D DEFAULT^RCDPAPST
14 ;
15 F D Q:'RCDEBTDA
16 . W !! S RCDEBTDA=$$SELACCT
17 . I RCDEBTDA<1 S RCDEBTDA=0 Q
18 . D EN^VALM("RCDP ACCOUNT PROFILE")
19 . ; fast exit
20 . I $G(RCDPFXIT) S RCDEBTDA=0
21 Q
22 ;
23 ;
24INIT ; initialization for list manager list
25 D INIT^RCDPAPLI
26 Q
27 ;
28 ;
29DIQ340(DA,DR) ; diq call to retrieve data for dr fields in file 340
30 N D0,DIC,DIQ,DIQ2
31 K RCDPDATA(340,DA)
32 S DIQ(0)="IE",DIC="^RCD(340,",DIQ="RCDPDATA" D EN^DIQ1
33 Q
34 ;
35 ;
36HDR ; header code for list manager display
37 I '$G(RCDEBTDA) S VALMHDR(1)="ACCOUNT NOT selected.",VALMHDR(2)="",VALMHDR(3)="" Q
38 ;
39 N DATA,IBRX,RCSPACE
40 S DATA=$$ACCNTHDR(RCDEBTDA)
41 ;
42 S RCSPACE="",$P(RCSPACE," ",81)=""
43 S VALMHDR(1)=$E("Account: "_$P(DATA,"^")_$P(DATA,"^",2)_RCSPACE,1,62)_$P(DATA,"^",3)
44 S VALMHDR(2)=$E(" Addr: "_$P(DATA,"^",4)_", "_$P(DATA,"^",7)_", "_$P(DATA,"^",8)_" "_$P(DATA,"^",9)_RCSPACE,1,58)_" Phone: "_$P(DATA,"^",10)
45 ;
46 S VALMHDR(3)=RCSPACE
47 I $P($G(^RCD(340,+RCDEBTDA,0)),"^")["DPT(" D
48 . S IBRX=$$RXST^IBARXEU(+$P($G(^RCD(340,+RCDEBTDA,0)),"^"),DT)
49 . S VALMHDR(3)=" RX Copay Exempt: "_$S($P(IBRX,"^")=1:"YES",$P(IBRX,"^")=0:"NO",1:"N/A")_RCSPACE
50 . I $P(IBRX,U)=1 D
51 . . N DIC,X,Y
52 . . S DIC="^IBE(354.2,",DIC(0)="M",X=+$P(IBRX,"^",3)
53 . . D ^DIC
54 . . I Y>0 S VALMHDR(3)=$E(VALMHDR(3),1,25)_"("_$P(Y,"^",2)_")"_RCSPACE
55 S VALMHDR(3)=$E(VALMHDR(3),1,80)
56 ;
57 S VALMHDR(4)=RCSPACE
58 I $G(RCTOTAL(1))="" S VALMHDR(4)=" ACCOUNT BALANCE: Unknown"
59 I $G(RCTOTAL(1))'="" D
60 . S VALMHDR(4)=" ACCOUNT BALANCE: "_$J($G(RCTOTAL(1))+$G(RCTOTAL(2))+$G(RCTOTAL(3))-$G(RCTOTAL("PP")),0,2)
61 . S VALMHDR(4)=VALMHDR(4)_" Pending Payments: "_$J($G(RCTOTAL("PP")),0,2)
62 I $O(^RCD(340,RCDEBTDA,2,0)) S VALMHDR(4)=$E($G(VALMHDR(4))_" ",1,72)_"COMMENT"
63 ;
64 ; highlight account balance
65 S VALMHDR(4)=IORVON_$E(VALMHDR(4),1,30)_IORVOFF_$E(VALMHDR(4),31,80)
66 Q
67 ;
68 ;
69EXIT ; exit list manager option and clean up
70 K ^TMP("RCDPAPLM",$J),^TMP("RCDPAPLMX",$J)
71 Q
72 ;
73 ;
74SELACCT() ; select an account (debtor)
75 ; returns -1 for timeout or ^, 0 for no selection, or ien of account
76 N %,%Y,A1,C,DIC,DIYS,DTOUT,DUOUT,RCRJFLAG,X,Y
77 F D Q:$G(RCRJFLAG)
78 . R !!,"Select ACCOUNT or BILL NUMBER: ",X:DTIME
79 . I '$T S Y=-1,DTOUT=1,RCRJFLAG=1 Q
80 . I X["^" S Y=-1,DUOUT=1,RCRJFLAG=1 Q
81 . I X="" S Y=0,RCRJFLAG=1 Q
82 . ;
83 . ; lookup bill
84 . S Y=$O(^PRCA(430,"B",X,0)) I 'Y S Y=$O(^PRCA(430,"D",X,0))
85 . I Y,$P($G(^PRCA(430,Y,0)),"^",9) S Y=$P(^(0),"^",9),^DISV(DUZ,"^PRCA(430,")=Y,RCRJFLAG=1 Q
86 . ;
87 . ; lookup account
88 . S DIC="^RCD(340,",DIC(0)="E"
89 . D ^DIC
90 . I Y'<0 S RCRJFLAG=1
91 I Y<0,'$G(DUOUT),'$G(DTOUT) S Y=0
92 Q +Y
93 ;
94 ;
95ACCNTHDR(RCDEBTDA) ; return account data (for headings)
96 I '$G(RCDEBTDA) Q ""
97 ;
98 N ADDRESS,DOB,RCDPDATA,SSN,Y
99 D DIQ340(RCDEBTDA,.01)
100 ;
101 ; get SSN and DOB if applicable
102 S SSN="",DOB=""
103 I RCDPDATA(340,RCDEBTDA,.01,"I")["DPT" D
104 . S SSN="("_$P($G(^DPT(+RCDPDATA(340,RCDEBTDA,.01,"I"),0)),"^",9)_")"
105 . S Y=$P($G(^DPT(+RCDPDATA(340,RCDEBTDA,.01,"I"),0)),"^",3) I Y D DD^%DT
106 . S DOB="DOB: "_Y
107 I RCDPDATA(340,RCDEBTDA,.01,"I")["VA(" D
108 . S SSN="("_$P($G(^VA(200,+RCDPDATA(340,RCDEBTDA,.01,"I"),0)),"^",9)_")"
109 . S Y=$P($G(^VA(200,+RCDPDATA(340,RCDEBTDA,.01,"I"),1)),"^",3) I Y D DD^%DT
110 . S DOB="DOB: "_Y
111 ;
112 S ADDRESS=$$DADD^RCAMADD(RCDPDATA(340,RCDEBTDA,.01,"I"))
113 I $P(ADDRESS,"^")="" S $P(ADDRESS,"^")="NO STREET"
114 I $P(ADDRESS,"^",4)="" S $P(ADDRESS,"^",4)="NO CITY"
115 I $P(ADDRESS,"^",5)="" S $P(ADDRESS,"^",5)="NO STATE"
116 I $P(ADDRESS,"^",6)="" S $P(ADDRESS,"^",6)="NO ZIP"
117 ;
118 ; account name ^ ssn ^ dob ^ street1 ^ street2 ^ street3 ^ city
119 ; ^ state ^ zip ^ phone
120 Q RCDPDATA(340,RCDEBTDA,.01,"E")_"^"_SSN_"^"_DOB_"^"_ADDRESS
Note: See TracBrowser for help on using the repository browser.