source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCAHV.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 8.8 KB
Line 
1PRCAHV ;LL/ELZ-API for My HealtheVet ;06/17/02
2 ;;4.5;Accounts Receivable;**183,209**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;Based on ALSIBAL, LL/ELZ, Version 3.0, 10/30/01 (Ed Zeigler)
5 ;
6 ;
7 ;Balance calculation (External entry point)
8 ;Input:
9 ; PRCAICN - Patient's ICN (required)
10 ; PRCATY - Account Receivable Transaction Types, possible values (case insensitive):
11 ; "OPEN" (default) the same as "113,112,102,107" - open/active Trans. Types
12 ; "ALL", all Transaction Types
13 ; <list of Trans.Type numbers, comma delimited>
14 ;Output:
15 ; 1-success, 0-no data, '-1'-error, '-2'-patient doesn't exist, '-3'-program error
16 ; RESULT (by reference)=<balance value> or zero if error/no data
17BALANCE(RESULT,PRCAICN,PRCATY) N DFN,RCST
18 S RESULT=0 ;Initial value
19 I $G(PRCAICN)="" S RCST=-1 G BALQ ;Bad parameter
20 S DFN=$$DFN($G(PRCAICN)) I 'DFN S RCST=-2 G BALQ ;No such patient
21 S RCST=$$INTBAL(.RESULT,DFN,.PRCATY)
22BALQ Q RCST
23 ;
24 ;
25 ;This function will look up a patient's detail to their copay balance
26 ;Input:
27 ; PRCAICN - Patient's ICN
28 ; PRCATY - Account Receivable Transaction Types, possible values (case insensitive):
29 ; "OPEN" (default) the same as "113,112,102,107" - open/active Trans. Types
30 ; "ALL", all Transaction Types,
31 ; <list of Trans.Type numbers, comma delimited>
32 ;Output: 1-success, 0-no data, '-1'-error, '-2'-patient doesn't exist, '-3'-program error
33 ; RESULT(1..n)=<Bill No>^<Date Bill Prepared(FM)>^<Description>^<Balance>^<Status Number>
34 ; RESULT may be undefined if error or no data
35DETAIL(RESULT,PRCAICN,PRCATY) N DFN,RCST
36 K RESULT ;Initial value
37 I $G(PRCAICN)="" S RCST=-1 G DETQ ;Bad parameter
38 S DFN=$$DFN($G(PRCAICN)) I 'DFN S RCST=-2 G DETQ ;No such patient
39 S RCST=$$INTDTL(.RESULT,DFN,.PRCATY)
40DETQ Q RCST
41 ;
42 ;
43 ;This function will look up for transaction details for the given bill
44 ;Input:
45 ; PRCABILL - Bill name (External number)
46 ;Output:
47 ; 1-success, 0-no data, '-1'-no parameter, '-2'-the bill doesn't exist, '-3'-program error
48 ; RESULT(i)=<Trans.No>^<Date(FM)>^<Trans.Type>^<reserved>^<Trans. amount>^<Descr1>^<Descr2>^<Descr3>^<Descr4>^<Descr5>
49 ; RESULT may be undefined if error or no data
50 ; RESULT(1..n) may not be longer that 255 char - the Description may be truncated.
51TRANS(RESULT,PRCABILL) N PRCAIEN,RCST
52 K RESULT ;Initial value
53 I $G(PRCABILL)="" S RCST=-1 G TRANSQ ;Bad parameter
54 S PRCAIEN=$$BILIEN($G(PRCABILL)) I 'PRCAIEN S RCST=-2 G TRANSQ ;No such bill
55 S RCST=$$INTTRANS(.RESULT,PRCAIEN)
56TRANSQ Q RCST
57 ;
58 ;Conversions
59 ;~~~~~~~~~~~
60 ;Input: Paient's ICN
61 ;Output: Patient's IEN (or 0 in not found)
62DFN(PRCAICN) ;Receive patient's IEN by ICN
63 N DFN
64 I $G(PRCAICN)="" Q 0 ;No parameter
65 S DFN=$O(^DPT("AICN",PRCAICN,0)) I 'DFN Q 0 ;Not found in x-ref
66 I '$D(^DPT(DFN)) Q 0 ;Invalid cross-reference
67 Q DFN
68 ;
69 ;Input: bill name ('external' number)
70 ;Output: bill IEN (internal record number) or 0 if not found
71BILIEN(PRCABN) ;Receive bill's IEN by name
72 N PRCAIEN
73 I $G(PRCABN)="" Q 0 ;No parameter
74 S PRCAIEN=$O(^PRCA(430,"B",PRCABN,0)) I 'PRCAIEN Q 0 ;Not found in x-ref
75 I '$D(^PRCA(430,PRCAIEN)) Q 0 ;Invalid cross-reference
76 Q PRCAIEN
77 ;
78 ;
79 ;Internal functions
80 ;~~~~~~~~~~~~~~~~~~
81 ; These functions accept internal codes (IEN),
82 ; return success code,
83 ; return requested data in parameter by reference (no data murging)
84 ;
85 ;
86 ;Balance calculation (internal entry point)
87 ;Input: DFN - Patient's IEN
88 ; PRCATY - Account Receivable Transaction Types, possible values:
89 ; "OPEN" (default) the same as "113,112,102,107" - open/active Trans. Types
90 ; "ALL", all Transaction Types
91 ; <list of Trans.Type numbers, comma delimited>
92 ;Output: 1-success, 0-no data, '-1'-error '-2'-patient doesn't exist
93 ; RESULT=<balance value> or zero if error/no data
94INTBAL(RESULT,DFN,PRCATY) ; this will look up a patient's copay balance
95 N X,Y,C,PRCADB,DEBT,TRAN,BILL,BAT
96 S RESULT=0
97 S X="ERROR^PRCAHV",@^%ZOSF("TRAP")
98 S:'$D(U) U="^"
99 ;
100 I '$G(DFN) Q -1 ;No/bad parameter
101 I '$D(^DPT(DFN)) Q -2 ;The patient does not exist
102 S PRCADB=DFN_";DPT(",DEBT=$O(^RCD(340,"B",PRCADB,0)) I 'DEBT Q 0 ;No such debtor
103 D ADJTYPE(.PRCATY) ; Adjust type (or set default)
104 ;Standard call. Parameters: PRCATY - types list, DEBT - debtor
105 K ^TMP("PRCAAPR",$J)
106 D COMP^PRCAAPR S RESULT=+$G(^TMP("PRCAAPR",$J,"C"))
107 K ^TMP("PRCAAPR",$J)
108 Q 1
109 ;
110 ;Function: Details of patient's balance
111 ;Input: DFN - Patient's IEN
112 ; PRCATY - Account Receivable Transaction Types, possible values:
113 ; "OPEN" (default) the same as "113,112,102,107" - open/active Trans. Types
114 ; "ALL", all Transaction Types
115 ; <list of Trans.Type numbers, comma delimited>
116 ;Output: 1-success, 0-no data, '-1'-error '-2'-patient doesn't exist
117 ; RESULT(1..n)=<Bill No>^<Date Bill Prepared(FM)>^<Description>^<Balance>^<Status Number>
118 ; RESULT may be undefined if error or no data
119INTDTL(RESULT,DFN,PRCATY) ;
120 N X,Y,C,PRCADB,DEBT,TRAN,BILL,BAT,RCS,RCX,RCC,RCZ,RCY,RCB,RCDT,RCP
121 K RESULT
122 S X="ERROR^PRCAHV",@^%ZOSF("TRAP")
123 S:'$D(U) U="^"
124 ;
125 I '$G(DFN) Q -1 ;No/bad parameter
126 I '$D(^DPT(DFN)) Q -2 ;No such patient
127 S PRCADB=DFN_";DPT(",DEBT=$O(^RCD(340,"B",PRCADB,0)) I 'DEBT Q 0 ;No information for the patient
128 ;
129 D ADJTYPE(.PRCATY) ; Adjust type (or set default)
130 ;Standard call. Parameters: PRCATY - types list, DEBT - debtor
131 K ^TMP("PRCAAPR",$J),^TMP("PRCAHV",$J)
132 D COMP^PRCAAPR
133 ;
134 ; Sort the bills by date, ignore 3rd party bills
135 S (RCC,RCS)=0 F S RCS=$O(^TMP("PRCAAPR",$J,"C",RCS)) Q:RCS<1 D
136 . S RCX=0 F S RCX=$O(^TMP("PRCAAPR",$J,"C",RCS,RCX)) Q:RCX<1 D
137 .. ; No support for unprocessed payments
138 .. I RCS=99 Q ;S RCC=RCC+1,RESULT(RCC)="^^UNPROCESSED PAYMENT^"_$G(^TMP("PRCAAPR",$J,"C",RCS,RCX)) Q
139 .. S RCY=$G(^PRCA(430,RCX,0)) Q:RCY=""
140 .. S PRCADB=$P(RCY,"^",9) ; bill debtor
141 .. I $P($G(^RCD(340,PRCADB,0)),U)'[";DPT(" Q ;not a 1st party bill
142 .. S RCDT=+$P(RCY,"^",10)
143 .. S ^TMP("PRCAHV",$J,RCDT,RCS,RCX)=$G(^TMP("PRCAAPR",$J,"C",RCS,RCX))
144 K ^TMP("PRCAAPR",$J)
145 ;
146 S (RCC,RCDT)=0 F S RCDT=$O(^TMP("PRCAHV",$J,RCDT)) Q:'RCDT D
147 . S RCS=0 F S RCS=$O(^TMP("PRCAHV",$J,RCDT,RCS)) Q:'RCS D
148 .. S RCX=0 F S RCX=$O(^TMP("PRCAHV",$J,RCDT,RCS,RCX)) Q:'RCX D
149 ... N RCDESC
150 ... D BILLDESC^RCCPCPS1(RCX)
151 ... S RCB=0,RCZ=$G(^TMP("PRCAHV",$J,RCDT,RCS,RCX))
152 ... F RCP=1:1:5 S RCB=RCB+$P(RCZ,U,RCP)
153 ... S RCY=^PRCA(430,RCX,0)
154 ... S RCC=RCC+1,RESULT(RCC)=$P(RCY,U)_U_$P(RCY,U,10)_U_RCDESC(1)_U_RCB_U_RCS
155 ;
156 K ^TMP("PRCAHV",$J)
157 Q 1 ;Success, data not guaranteed
158 ;
159 ;Function: Transaction details
160 ;Input: RCBILL - Bill IEN
161 ;Output: 1-success, 0-no data, '-1'-no parameter '-2'-the bill doesn't exist, '-3'-program error
162 ; RESULT(i)=<Trans.No>^<Date(FM)>^<Trans.Type>^<reserved>^<Trans. amount>^<Descr1>^<Descr2>^<Descr3>^<Descr4>^<Descr5>
163 ; RESULT may be undefined if error or no data
164INTTRANS(RESULT,RCBILL) ; returns transaction details for the given bill IEN
165 N RCTRAN,RCNUM,X,Y,C
166 K RESULT
167 S X="ERROR^PRCAHV",@^%ZOSF("TRAP")
168 S:'$D(U) U="^"
169 I $G(RCBILL)="" Q -1 ;Bad parameter
170 I '$D(^PRCA(430,RCBILL,0)) Q -2 ;The bill doesn't exist
171 I '$D(^PRCA(433,"C",RCBILL)) Q 0 ;No data
172 S (RCNUM,RCTRAN)=0 F S RCTRAN=$O(^PRCA(433,"C",RCBILL,RCTRAN)) Q:'RCTRAN D
173 . Q:'$D(^PRCA(433,RCTRAN,0)) ;Corrupted cross-reference
174 . N RCDESC,RCTOTAL,RCY,RCI,RCTXT,RCD,RCTTY,RCAMT
175 . D TRANDESC^RCCPCPS1(RCTRAN)
176 . S RCY=$G(^PRCA(433,RCTRAN,1))
177 . S RCTTY=$P(RCY,U,2) ; Transaction Type
178 . S RCAMT=$P(RCY,U,5) ; Transaction Amount
179 . I ",2,8,9,10,11,14,19,47,34,35,29,"[(","_RCTTY_",") I RCAMT'<0 S RCAMT=-RCAMT
180 . I ",2,8,9,10,11,12,14,19,47,34,35,29,"'[(","_RCTTY_",") I RCAMT<0 S RCAMT=-RCAMT
181 . ;S RCTXT=RCTRAN_U_$P(RCY,U)_U_$G(RCTOTAL("INT"))_U_$G(RCTOTAL("ADM"))_U_$P(RCY,U,5)
182 . S RCTXT=RCTRAN_U_$P(RCY,U)_U_RCTTY_U_U_RCAMT
183 . S RCI=0 F S RCI=$O(RCDESC(RCI)) Q:'RCI S RCD=$$TRIM(RCDESC(RCI)) Q:($L(RCD)+$L(RCTXT))>254 S RCTXT=RCTXT_U_RCD
184 . S RCNUM=RCNUM+1
185 . S RESULT(RCNUM)=RCTXT
186 ;
187 Q 1 ;Success, data not guaranteed
188 ;
189TRIM(RCTXT) ;Remove starting and ending spaces
190 N RCI,RES
191 S RES=RCTXT
192 F RCI=1:1:$L(RES) Q:$E(RES,RCI)'=" "
193 I RCI>1 S $E(RES,1,RCI-1)=""
194 F RCI=$L(RES):-1:1 Q:$E(RES,RCI)'=" "
195 I RCI<$L(RES) S $E(RES,RCI+1,$L(RES))=""
196 Q RES
197 ;
198 ;Adjust Account Receivable Transaction Type:
199 ;1) Convert to upper case
200 ;2) Undefined will became "OPEN"
201 ;3) OPEN will became "113,112,102,107"
202ADJTYPE(RCTYPE) ;
203 S RCTYPE=$TR($G(RCTYPE,"OPEN"),"openal ","OPENAL") ; Convert tp upper case
204 I RCTYPE="OPEN" S RCTYPE="113,112,102,107"
205 Q
206 ;
207 ;Program error trap
208ERROR Q -3
209 ;
210 ;Temporary entry points - test only! Will be removed after testing
211TEST N C,R,P,A,O
212 S (P,C)=0 F S P=$O(^DPT("AICN",P)) Q:'P S R=$$DETAIL(.O,P,"ALL") I R>0 I $D(O) W !,P,?20,R,! D TESTZW(.O) S C=C+1 Q:C>500
213 Q
214 ;
215TEST2 N C,R,P,A
216 S (P,C)=0 F S P=$O(^PRCA(430,"B",P)) Q:'P S R=$$TRANS(.A,P) I R W !,P,?20,R,! I $D(A) D TESTZW(.A) S C=C+1 Q:C>500
217 Q
218TESTZW(PRA) N RCI
219 S RCI="" F S RCI=$O(PRA(RCI)) Q:'RCI W !,RCI,?10,PRA(RCI)
220 Q
Note: See TracBrowser for help on using the repository browser.