source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPAPST.m@ 1780

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

initial load of WorldVistAEHR
File size: 4.6 KB
Line 
1RCDPAPST ;WISC/RFJ-account profile bill status select ;1 Jun 99
2 ;;4.5;Accounts Receivable;**114,168**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7SELSTAT ; select a status called from listmanager
8 D FULL^VALM1
9 S VALMBCK="R"
10 ;
11 W !!,"This option will allow you to specify which bill statuses to display."
12 D GETSTAT(RCDEBTDA)
13 ;
14 D INIT^RCDPAPLM
15 Q
16 ;
17 ;
18GETSTAT(RCDEBTDA) ; select the list of statuses of bills to display for an account
19 ; if rcdebtda passed, it will show selectable statuses for this account
20 N %,DIR,DIRUT,RCRJFLAG,RCSTAT,RCSTATSL,STATDA,STATLIST,X,Y
21 ;
22 ; get the status list for the user
23 D STATDEF
24 ;
25 ; build list of possible statuses for AR package (show statuses used)
26 S STATLIST=""
27 S STATDA=0 F S STATDA=$O(^PRCA(430,"ASDT",STATDA)) Q:'STATDA D
28 . S RCSTAT(STATDA)=$P($G(^PRCA(430.3,STATDA,0)),"^")
29 . S STATLIST=STATLIST_STATDA_":"_$E(RCSTAT(STATDA),1,20)_";"
30 S STATLIST=STATLIST_"*:ALL statuses;-:NO statuses;"
31 ;
32 F D Q:$G(RCRJFLAG)
33 . D SHOWSTAT(RCDEBTDA)
34 . S DIR(0)="SOA^"_STATLIST,DIR("A")="Select STATUS of bills to display: "
35 . D ^DIR
36 . I $D(DIRUT) S RCRJFLAG=1 Q
37 . I Y="*" S %=0 F S %=$O(RCSTAT(%)) Q:'% S RCSTATSL(%)=1
38 . I Y="-" K RCSTATSL Q
39 . S Y=+Y
40 . I $D(RCSTAT(Y)) D
41 . . I $D(RCSTATSL(Y)) K RCSTATSL(Y) W " un-selected" Q
42 . . S RCSTATSL(Y)=1 W " selected"
43 ;
44 ; save as default for user
45 S STATLIST=""
46 S STATDA=0 F S STATDA=$O(RCSTATSL(STATDA)) Q:'STATDA S STATLIST=STATLIST_STATDA_"^"
47 S ^DISV(DUZ,"RCDPAPLM","STATUS")=STATLIST
48 Q
49 ;
50 ;
51STATDEF ; get list of statuses for the user
52 ; returns RCSTATSL(statda)
53 N %,STATDA
54 ; build default selected statuses
55 K RCSTATSL
56 F %=1:1 S STATDA=$P($G(^DISV(DUZ,"RCDPAPLM","STATUS")),"^",%) Q:'STATDA S RCSTATSL(STATDA)=1
57 Q
58 ;
59 ;
60DEFAULT ; set the default statuses
61 W !
62 W !,"When using this option, you have the option to select bills to display by"
63 W !,"status. You can select a list of statuses of the bills to display. After"
64 W !,"you select the list of statuses, the option will retain the list of selected"
65 W !,"statuses for the next time you enter this option. Since you currently do"
66 W !,"not have any statuses selected for your list, the default statuses of"
67 W !,"active, open, pending calm, and refund review will be automatically"
68 W !,"selected for your list now."
69 ; active(16), open(42), pending calm(21), refund review(44)
70 S ^DISV(DUZ,"RCDPAPLM","STATUS")="16^42^21^44"
71 Q
72 ;
73 ;
74SHOWSTAT(RCDEBTDA) ; show list of statuses
75 N OFFSET,STARS,STATDA
76 W !!?3,"The following is a list of available statuses for bills:"
77 W !?3,"--------------------------------------------------------"
78 S OFFSET=0
79 S STATDA=0 F S STATDA=$O(RCSTAT(STATDA)) Q:'STATDA D
80 . I OFFSET=0 W !
81 . W ?(OFFSET)
82 . ; does account have bills under status, if yes show stars
83 . S STARS=" "
84 . I $G(RCDEBTDA),$D(^PRCA(430,"AS",RCDEBTDA,STATDA)) S STARS="**"
85 . W STARS," ",$E(STATDA_" ",1,2)," ",$E(RCSTAT(STATDA)_" ",1,16)
86 . ; user has status selected
87 . I $G(RCSTATSL(STATDA)) W " selected"
88 . S OFFSET=OFFSET+44
89 . I OFFSET>44 S OFFSET=0
90 W !,"** indicates account has bills under status **",!
91 Q
92 ;
93 ;
94GETBILLS(RCDEBTDA) ; bills for account
95 ; returns a list of bills in ^tmp("rcdpapst",$j,actdate,status,bill)
96 N BILLDA,DATE,STATDA
97 K ^TMP("RCDPAPST",$J)
98 ;
99 S STATDA=0 F S STATDA=$O(^PRCA(430,"AS",RCDEBTDA,STATDA)) Q:'STATDA D
100 . S BILLDA=0 F S BILLDA=$O(^PRCA(430,"AS",RCDEBTDA,STATDA,BILLDA)) Q:'BILLDA D
101 . . S DATE=$P($G(^PRCA(430,BILLDA,6)),"^",21) I 'DATE Q
102 . . S ^TMP("RCDPAPST",$J,$P(DATE,"."),STATDA,BILLDA)=$$BILLBAL(BILLDA,0)
103 Q
104 ;
105 ;
106BILLBAL(BILLDA,EXTERNAL) ; return a bills current balance principal ^ interest ^ admin
107 ; set the external flag if data is being reported to an external system
108 ; like fms, ndb, ig, etc.
109 N ADMIN,CATEG,DATA7,INTEREST,PRINCPAL,STATDA
110 S DATA7=$G(^PRCA(430,BILLDA,7))
111 S PRINCPAL=$P(DATA7,"^")
112 S INTEREST=$P(DATA7,"^",2)
113 S ADMIN=$P(DATA7,"^",3)+$P(DATA7,"^",4)+$P(DATA7,"^",5)
114 ;
115 S CATEG=$P(^PRCA(430,BILLDA,0),"^",2),STATDA=$P(^(0),"^",8)
116 ;
117 ; special case for prepayments (26)
118 I CATEG=26 D
119 . S PRINCPAL=-PRINCPAL,(INTEREST,ADMIN)=0
120 . ; bill status not open, active, or in refund review
121 . I STATDA'=42,STATDA'=16,STATDA'=44 S PRINCPAL=0
122 ;
123 ; if the bill's status is write-off, balance and int = 0
124 I STATDA=23 S (PRINCPAL,INTEREST,ADMIN)=0
125 ; if the bill's status is suspended, balance and int = 0
126 ; this would be for collecting payments only, external systems
127 ; still would get the bills balance
128 I STATDA=40,'$G(EXTERNAL) S (PRINCPAL,INTEREST,ADMIN)=0
129 ;
130 Q PRINCPAL_"^"_INTEREST_"^"_ADMIN
Note: See TracBrowser for help on using the repository browser.