| [613] | 1 | PRCAHV ;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
|
|---|
| 17 | BALANCE(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)
|
|---|
| 22 | BALQ 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
|
|---|
| 35 | DETAIL(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)
|
|---|
| 40 | DETQ 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.
|
|---|
| 51 | TRANS(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)
|
|---|
| 56 | TRANSQ Q RCST
|
|---|
| 57 | ;
|
|---|
| 58 | ;Conversions
|
|---|
| 59 | ;~~~~~~~~~~~
|
|---|
| 60 | ;Input: Paient's ICN
|
|---|
| 61 | ;Output: Patient's IEN (or 0 in not found)
|
|---|
| 62 | DFN(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
|
|---|
| 71 | BILIEN(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
|
|---|
| 94 | INTBAL(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
|
|---|
| 119 | INTDTL(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
|
|---|
| 164 | INTTRANS(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 | ;
|
|---|
| 189 | TRIM(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"
|
|---|
| 202 | ADJTYPE(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
|
|---|
| 208 | ERROR Q -3
|
|---|
| 209 | ;
|
|---|
| 210 | ;Temporary entry points - test only! Will be removed after testing
|
|---|
| 211 | TEST 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 | ;
|
|---|
| 215 | TEST2 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
|
|---|
| 218 | TESTZW(PRA) N RCI
|
|---|
| 219 | S RCI="" F S RCI=$O(PRA(RCI)) Q:'RCI W !,RCI,?10,PRA(RCI)
|
|---|
| 220 | Q
|
|---|
