PRCAHV ;LL/ELZ-API for My HealtheVet ;06/17/02
;;4.5;Accounts Receivable;**183,209**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
;Based on ALSIBAL, LL/ELZ, Version 3.0, 10/30/01 (Ed Zeigler)
;
;
;Balance calculation (External entry point)
;Input:
; PRCAICN - Patient's ICN (required)
; PRCATY - Account Receivable Transaction Types, possible values (case insensitive):
; "OPEN" (default) the same as "113,112,102,107" - open/active Trans. Types
; "ALL", all Transaction Types
; <list of Trans.Type numbers, comma delimited>
;Output:
; 1-success, 0-no data, '-1'-error, '-2'-patient doesn't exist, '-3'-program error
; RESULT (by reference)=<balance value> or zero if error/no data
BALANCE(RESULT,PRCAICN,PRCATY) N DFN,RCST
S RESULT=0 ;Initial value
I $G(PRCAICN)="" S RCST=-1 G BALQ ;Bad parameter
S DFN=$$DFN($G(PRCAICN)) I 'DFN S RCST=-2 G BALQ ;No such patient
S RCST=$$INTBAL(.RESULT,DFN,.PRCATY)
BALQ Q RCST
;
;
;This function will look up a patient's detail to their copay balance
;Input:
; PRCAICN - Patient's ICN
; PRCATY - Account Receivable Transaction Types, possible values (case insensitive):
; "OPEN" (default) the same as "113,112,102,107" - open/active Trans. Types
; "ALL", all Transaction Types,
; <list of Trans.Type numbers, comma delimited>
;Output: 1-success, 0-no data, '-1'-error, '-2'-patient doesn't exist, '-3'-program error
; RESULT(1..n)=<Bill No>^<Date Bill Prepared(FM)>^<Description>^<Balance>^<Status Number>
; RESULT may be undefined if error or no data
DETAIL(RESULT,PRCAICN,PRCATY) N DFN,RCST
K RESULT ;Initial value
I $G(PRCAICN)="" S RCST=-1 G DETQ ;Bad parameter
S DFN=$$DFN($G(PRCAICN)) I 'DFN S RCST=-2 G DETQ ;No such patient
S RCST=$$INTDTL(.RESULT,DFN,.PRCATY)
DETQ Q RCST
;
;
;This function will look up for transaction details for the given bill
;Input:
; PRCABILL - Bill name (External number)
;Output:
; 1-success, 0-no data, '-1'-no parameter, '-2'-the bill doesn't exist, '-3'-program error
; RESULT(i)=<Trans.No>^<Date(FM)>^<Trans.Type>^<reserved>^<Trans. amount>^<Descr1>^<Descr2>^<Descr3>^<Descr4>^<Descr5>
; RESULT may be undefined if error or no data
; RESULT(1..n) may not be longer that 255 char - the Description may be truncated.
TRANS(RESULT,PRCABILL) N PRCAIEN,RCST
K RESULT ;Initial value
I $G(PRCABILL)="" S RCST=-1 G TRANSQ ;Bad parameter
S PRCAIEN=$$BILIEN($G(PRCABILL)) I 'PRCAIEN S RCST=-2 G TRANSQ ;No such bill
S RCST=$$INTTRANS(.RESULT,PRCAIEN)
TRANSQ Q RCST
;
;Conversions
;~~~~~~~~~~~
;Input: Paient's ICN
;Output: Patient's IEN (or 0 in not found)
DFN(PRCAICN) ;Receive patient's IEN by ICN
N DFN
I $G(PRCAICN)="" Q 0 ;No parameter
S DFN=$O(^DPT("AICN",PRCAICN,0)) I 'DFN Q 0 ;Not found in x-ref
I '$D(^DPT(DFN)) Q 0 ;Invalid cross-reference
Q DFN
;
;Input: bill name ('external' number)
;Output: bill IEN (internal record number) or 0 if not found
BILIEN(PRCABN) ;Receive bill's IEN by name
N PRCAIEN
I $G(PRCABN)="" Q 0 ;No parameter
S PRCAIEN=$O(^PRCA(430,"B",PRCABN,0)) I 'PRCAIEN Q 0 ;Not found in x-ref
I '$D(^PRCA(430,PRCAIEN)) Q 0 ;Invalid cross-reference
Q PRCAIEN
;
;
;Internal functions
;~~~~~~~~~~~~~~~~~~
; These functions accept internal codes (IEN),
; return success code,
; return requested data in parameter by reference (no data murging)
;
;
;Balance calculation (internal entry point)
;Input: DFN - Patient's IEN
; PRCATY - Account Receivable Transaction Types, possible values:
; "OPEN" (default) the same as "113,112,102,107" - open/active Trans. Types
; "ALL", all Transaction Types
; <list of Trans.Type numbers, comma delimited>
;Output: 1-success, 0-no data, '-1'-error '-2'-patient doesn't exist
; RESULT=<balance value> or zero if error/no data
INTBAL(RESULT,DFN,PRCATY) ; this will look up a patient's copay balance
N X,Y,C,PRCADB,DEBT,TRAN,BILL,BAT
S RESULT=0
S X="ERROR^PRCAHV",@^%ZOSF("TRAP")
S:'$D(U) U="^"
;
I '$G(DFN) Q -1 ;No/bad parameter
I '$D(^DPT(DFN)) Q -2 ;The patient does not exist
S PRCADB=DFN_";DPT(",DEBT=$O(^RCD(340,"B",PRCADB,0)) I 'DEBT Q 0 ;No such debtor
D ADJTYPE(.PRCATY) ; Adjust type (or set default)
;Standard call. Parameters: PRCATY - types list, DEBT - debtor
K ^TMP("PRCAAPR",$J)
D COMP^PRCAAPR S RESULT=+$G(^TMP("PRCAAPR",$J,"C"))
K ^TMP("PRCAAPR",$J)
Q 1
;
;Function: Details of patient's balance
;Input: DFN - Patient's IEN
; PRCATY - Account Receivable Transaction Types, possible values:
; "OPEN" (default) the same as "113,112,102,107" - open/active Trans. Types
; "ALL", all Transaction Types
; <list of Trans.Type numbers, comma delimited>
;Output: 1-success, 0-no data, '-1'-error '-2'-patient doesn't exist
; RESULT(1..n)=<Bill No>^<Date Bill Prepared(FM)>^<Description>^<Balance>^<Status Number>
; RESULT may be undefined if error or no data
INTDTL(RESULT,DFN,PRCATY) ;
N X,Y,C,PRCADB,DEBT,TRAN,BILL,BAT,RCS,RCX,RCC,RCZ,RCY,RCB,RCDT,RCP
K RESULT
S X="ERROR^PRCAHV",@^%ZOSF("TRAP")
S:'$D(U) U="^"
;
I '$G(DFN) Q -1 ;No/bad parameter
I '$D(^DPT(DFN)) Q -2 ;No such patient
S PRCADB=DFN_";DPT(",DEBT=$O(^RCD(340,"B",PRCADB,0)) I 'DEBT Q 0 ;No information for the patient
;
D ADJTYPE(.PRCATY) ; Adjust type (or set default)
;Standard call. Parameters: PRCATY - types list, DEBT - debtor
K ^TMP("PRCAAPR",$J),^TMP("PRCAHV",$J)
D COMP^PRCAAPR
;
; Sort the bills by date, ignore 3rd party bills
S (RCC,RCS)=0 F S RCS=$O(^TMP("PRCAAPR",$J,"C",RCS)) Q:RCS<1 D
. S RCX=0 F S RCX=$O(^TMP("PRCAAPR",$J,"C",RCS,RCX)) Q:RCX<1 D
.. ; No support for unprocessed payments
.. I RCS=99 Q ;S RCC=RCC+1,RESULT(RCC)="^^UNPROCESSED PAYMENT^"_$G(^TMP("PRCAAPR",$J,"C",RCS,RCX)) Q
.. S RCY=$G(^PRCA(430,RCX,0)) Q:RCY=""
.. S PRCADB=$P(RCY,"^",9) ; bill debtor
.. I $P($G(^RCD(340,PRCADB,0)),U)'[";DPT(" Q ;not a 1st party bill
.. S RCDT=+$P(RCY,"^",10)
.. S ^TMP("PRCAHV",$J,RCDT,RCS,RCX)=$G(^TMP("PRCAAPR",$J,"C",RCS,RCX))
K ^TMP("PRCAAPR",$J)
;
S (RCC,RCDT)=0 F S RCDT=$O(^TMP("PRCAHV",$J,RCDT)) Q:'RCDT D
. S RCS=0 F S RCS=$O(^TMP("PRCAHV",$J,RCDT,RCS)) Q:'RCS D
.. S RCX=0 F S RCX=$O(^TMP("PRCAHV",$J,RCDT,RCS,RCX)) Q:'RCX D
... N RCDESC
... D BILLDESC^RCCPCPS1(RCX)
... S RCB=0,RCZ=$G(^TMP("PRCAHV",$J,RCDT,RCS,RCX))
... F RCP=1:1:5 S RCB=RCB+$P(RCZ,U,RCP)
... S RCY=^PRCA(430,RCX,0)
... S RCC=RCC+1,RESULT(RCC)=$P(RCY,U)_U_$P(RCY,U,10)_U_RCDESC(1)_U_RCB_U_RCS
;
K ^TMP("PRCAHV",$J)
Q 1 ;Success, data not guaranteed
;
;Function: Transaction details
;Input: RCBILL - Bill IEN
;Output: 1-success, 0-no data, '-1'-no parameter '-2'-the bill doesn't exist, '-3'-program error
; RESULT(i)=<Trans.No>^<Date(FM)>^<Trans.Type>^<reserved>^<Trans. amount>^<Descr1>^<Descr2>^<Descr3>^<Descr4>^<Descr5>
; RESULT may be undefined if error or no data
INTTRANS(RESULT,RCBILL) ; returns transaction details for the given bill IEN
N RCTRAN,RCNUM,X,Y,C
K RESULT
S X="ERROR^PRCAHV",@^%ZOSF("TRAP")
S:'$D(U) U="^"
I $G(RCBILL)="" Q -1 ;Bad parameter
I '$D(^PRCA(430,RCBILL,0)) Q -2 ;The bill doesn't exist
I '$D(^PRCA(433,"C",RCBILL)) Q 0 ;No data
S (RCNUM,RCTRAN)=0 F S RCTRAN=$O(^PRCA(433,"C",RCBILL,RCTRAN)) Q:'RCTRAN D
. Q:'$D(^PRCA(433,RCTRAN,0)) ;Corrupted cross-reference
. N RCDESC,RCTOTAL,RCY,RCI,RCTXT,RCD,RCTTY,RCAMT
. D TRANDESC^RCCPCPS1(RCTRAN)
. S RCY=$G(^PRCA(433,RCTRAN,1))
. S RCTTY=$P(RCY,U,2) ; Transaction Type
. S RCAMT=$P(RCY,U,5) ; Transaction Amount
. I ",2,8,9,10,11,14,19,47,34,35,29,"[(","_RCTTY_",") I RCAMT'<0 S RCAMT=-RCAMT
. I ",2,8,9,10,11,12,14,19,47,34,35,29,"'[(","_RCTTY_",") I RCAMT<0 S RCAMT=-RCAMT
. ;S RCTXT=RCTRAN_U_$P(RCY,U)_U_$G(RCTOTAL("INT"))_U_$G(RCTOTAL("ADM"))_U_$P(RCY,U,5)
. S RCTXT=RCTRAN_U_$P(RCY,U)_U_RCTTY_U_U_RCAMT
. 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
. S RCNUM=RCNUM+1
. S RESULT(RCNUM)=RCTXT
;
Q 1 ;Success, data not guaranteed
;
TRIM(RCTXT) ;Remove starting and ending spaces
N RCI,RES
S RES=RCTXT
F RCI=1:1:$L(RES) Q:$E(RES,RCI)'=" "
I RCI>1 S $E(RES,1,RCI-1)=""
F RCI=$L(RES):-1:1 Q:$E(RES,RCI)'=" "
I RCI<$L(RES) S $E(RES,RCI+1,$L(RES))=""
Q RES
;
;Adjust Account Receivable Transaction Type:
;1) Convert to upper case
;2) Undefined will became "OPEN"
;3) OPEN will became "113,112,102,107"
ADJTYPE(RCTYPE) ;
S RCTYPE=$TR($G(RCTYPE,"OPEN"),"openal ","OPENAL") ; Convert tp upper case
I RCTYPE="OPEN" S RCTYPE="113,112,102,107"
Q
;
;Program error trap
ERROR Q -3
;
;Temporary entry points - test only! Will be removed after testing
TEST N C,R,P,A,O
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
Q
;
TEST2 N C,R,P,A
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
Q
TESTZW(PRA) N RCI
S RCI="" F S RCI=$O(PRA(RCI)) Q:'RCI W !,RCI,?10,PRA(RCI)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCAHV 9208 printed Sep 23, 2025@19:15:53 Page 2
PRCAHV ;LL/ELZ-API for My HealtheVet ;06/17/02
+1 ;;4.5;Accounts Receivable;**183,209**;Mar 20, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;Based on ALSIBAL, LL/ELZ, Version 3.0, 10/30/01 (Ed Zeigler)
+4 ;
+5 ;
+6 ;Balance calculation (External entry point)
+7 ;Input:
+8 ; PRCAICN - Patient's ICN (required)
+9 ; PRCATY - Account Receivable Transaction Types, possible values (case insensitive):
+10 ; "OPEN" (default) the same as "113,112,102,107" - open/active Trans. Types
+11 ; "ALL", all Transaction Types
+12 ; <list of Trans.Type numbers, comma delimited>
+13 ;Output:
+14 ; 1-success, 0-no data, '-1'-error, '-2'-patient doesn't exist, '-3'-program error
+15 ; RESULT (by reference)=<balance value> or zero if error/no data
BALANCE(RESULT,PRCAICN,PRCATY) NEW DFN,RCST
+1 ;Initial value
SET RESULT=0
+2 ;Bad parameter
IF $GET(PRCAICN)=""
SET RCST=-1
GOTO BALQ
+3 ;No such patient
SET DFN=$$DFN($GET(PRCAICN))
IF 'DFN
SET RCST=-2
GOTO BALQ
+4 SET RCST=$$INTBAL(.RESULT,DFN,.PRCATY)
BALQ QUIT RCST
+1 ;
+2 ;
+3 ;This function will look up a patient's detail to their copay balance
+4 ;Input:
+5 ; PRCAICN - Patient's ICN
+6 ; PRCATY - Account Receivable Transaction Types, possible values (case insensitive):
+7 ; "OPEN" (default) the same as "113,112,102,107" - open/active Trans. Types
+8 ; "ALL", all Transaction Types,
+9 ; <list of Trans.Type numbers, comma delimited>
+10 ;Output: 1-success, 0-no data, '-1'-error, '-2'-patient doesn't exist, '-3'-program error
+11 ; RESULT(1..n)=<Bill No>^<Date Bill Prepared(FM)>^<Description>^<Balance>^<Status Number>
+12 ; RESULT may be undefined if error or no data
DETAIL(RESULT,PRCAICN,PRCATY) NEW DFN,RCST
+1 ;Initial value
KILL RESULT
+2 ;Bad parameter
IF $GET(PRCAICN)=""
SET RCST=-1
GOTO DETQ
+3 ;No such patient
SET DFN=$$DFN($GET(PRCAICN))
IF 'DFN
SET RCST=-2
GOTO DETQ
+4 SET RCST=$$INTDTL(.RESULT,DFN,.PRCATY)
DETQ QUIT RCST
+1 ;
+2 ;
+3 ;This function will look up for transaction details for the given bill
+4 ;Input:
+5 ; PRCABILL - Bill name (External number)
+6 ;Output:
+7 ; 1-success, 0-no data, '-1'-no parameter, '-2'-the bill doesn't exist, '-3'-program error
+8 ; RESULT(i)=<Trans.No>^<Date(FM)>^<Trans.Type>^<reserved>^<Trans. amount>^<Descr1>^<Descr2>^<Descr3>^<Descr4>^<Descr5>
+9 ; RESULT may be undefined if error or no data
+10 ; RESULT(1..n) may not be longer that 255 char - the Description may be truncated.
TRANS(RESULT,PRCABILL) NEW PRCAIEN,RCST
+1 ;Initial value
KILL RESULT
+2 ;Bad parameter
IF $GET(PRCABILL)=""
SET RCST=-1
GOTO TRANSQ
+3 ;No such bill
SET PRCAIEN=$$BILIEN($GET(PRCABILL))
IF 'PRCAIEN
SET RCST=-2
GOTO TRANSQ
+4 SET RCST=$$INTTRANS(.RESULT,PRCAIEN)
TRANSQ QUIT RCST
+1 ;
+2 ;Conversions
+3 ;~~~~~~~~~~~
+4 ;Input: Paient's ICN
+5 ;Output: Patient's IEN (or 0 in not found)
DFN(PRCAICN) ;Receive patient's IEN by ICN
+1 NEW DFN
+2 ;No parameter
IF $GET(PRCAICN)=""
QUIT 0
+3 ;Not found in x-ref
SET DFN=$ORDER(^DPT("AICN",PRCAICN,0))
IF 'DFN
QUIT 0
+4 ;Invalid cross-reference
IF '$DATA(^DPT(DFN))
QUIT 0
+5 QUIT DFN
+6 ;
+7 ;Input: bill name ('external' number)
+8 ;Output: bill IEN (internal record number) or 0 if not found
BILIEN(PRCABN) ;Receive bill's IEN by name
+1 NEW PRCAIEN
+2 ;No parameter
IF $GET(PRCABN)=""
QUIT 0
+3 ;Not found in x-ref
SET PRCAIEN=$ORDER(^PRCA(430,"B",PRCABN,0))
IF 'PRCAIEN
QUIT 0
+4 ;Invalid cross-reference
IF '$DATA(^PRCA(430,PRCAIEN))
QUIT 0
+5 QUIT PRCAIEN
+6 ;
+7 ;
+8 ;Internal functions
+9 ;~~~~~~~~~~~~~~~~~~
+10 ; These functions accept internal codes (IEN),
+11 ; return success code,
+12 ; return requested data in parameter by reference (no data murging)
+13 ;
+14 ;
+15 ;Balance calculation (internal entry point)
+16 ;Input: DFN - Patient's IEN
+17 ; PRCATY - Account Receivable Transaction Types, possible values:
+18 ; "OPEN" (default) the same as "113,112,102,107" - open/active Trans. Types
+19 ; "ALL", all Transaction Types
+20 ; <list of Trans.Type numbers, comma delimited>
+21 ;Output: 1-success, 0-no data, '-1'-error '-2'-patient doesn't exist
+22 ; RESULT=<balance value> or zero if error/no data
INTBAL(RESULT,DFN,PRCATY) ; this will look up a patient's copay balance
+1 NEW X,Y,C,PRCADB,DEBT,TRAN,BILL,BAT
+2 SET RESULT=0
+3 SET X="ERROR^PRCAHV"
SET @^%ZOSF("TRAP")
+4 if '$DATA(U)
SET U="^"
+5 ;
+6 ;No/bad parameter
IF '$GET(DFN)
QUIT -1
+7 ;The patient does not exist
IF '$DATA(^DPT(DFN))
QUIT -2
+8 ;No such debtor
SET PRCADB=DFN_";DPT("
SET DEBT=$ORDER(^RCD(340,"B",PRCADB,0))
IF 'DEBT
QUIT 0
+9 ; Adjust type (or set default)
DO ADJTYPE(.PRCATY)
+10 ;Standard call. Parameters: PRCATY - types list, DEBT - debtor
+11 KILL ^TMP("PRCAAPR",$JOB)
+12 DO COMP^PRCAAPR
SET RESULT=+$GET(^TMP("PRCAAPR",$JOB,"C"))
+13 KILL ^TMP("PRCAAPR",$JOB)
+14 QUIT 1
+15 ;
+16 ;Function: Details of patient's balance
+17 ;Input: DFN - Patient's IEN
+18 ; PRCATY - Account Receivable Transaction Types, possible values:
+19 ; "OPEN" (default) the same as "113,112,102,107" - open/active Trans. Types
+20 ; "ALL", all Transaction Types
+21 ; <list of Trans.Type numbers, comma delimited>
+22 ;Output: 1-success, 0-no data, '-1'-error '-2'-patient doesn't exist
+23 ; RESULT(1..n)=<Bill No>^<Date Bill Prepared(FM)>^<Description>^<Balance>^<Status Number>
+24 ; RESULT may be undefined if error or no data
INTDTL(RESULT,DFN,PRCATY) ;
+1 NEW X,Y,C,PRCADB,DEBT,TRAN,BILL,BAT,RCS,RCX,RCC,RCZ,RCY,RCB,RCDT,RCP
+2 KILL RESULT
+3 SET X="ERROR^PRCAHV"
SET @^%ZOSF("TRAP")
+4 if '$DATA(U)
SET U="^"
+5 ;
+6 ;No/bad parameter
IF '$GET(DFN)
QUIT -1
+7 ;No such patient
IF '$DATA(^DPT(DFN))
QUIT -2
+8 ;No information for the patient
SET PRCADB=DFN_";DPT("
SET DEBT=$ORDER(^RCD(340,"B",PRCADB,0))
IF 'DEBT
QUIT 0
+9 ;
+10 ; Adjust type (or set default)
DO ADJTYPE(.PRCATY)
+11 ;Standard call. Parameters: PRCATY - types list, DEBT - debtor
+12 KILL ^TMP("PRCAAPR",$JOB),^TMP("PRCAHV",$JOB)
+13 DO COMP^PRCAAPR
+14 ;
+15 ; Sort the bills by date, ignore 3rd party bills
+16 SET (RCC,RCS)=0
FOR
SET RCS=$ORDER(^TMP("PRCAAPR",$JOB,"C",RCS))
if RCS<1
QUIT
Begin DoDot:1
+17 SET RCX=0
FOR
SET RCX=$ORDER(^TMP("PRCAAPR",$JOB,"C",RCS,RCX))
if RCX<1
QUIT
Begin DoDot:2
+18 ; No support for unprocessed payments
+19 ;S RCC=RCC+1,RESULT(RCC)="^^UNPROCESSED PAYMENT^"_$G(^TMP("PRCAAPR",$J,"C",RCS,RCX)) Q
IF RCS=99
QUIT
+20 SET RCY=$GET(^PRCA(430,RCX,0))
if RCY=""
QUIT
+21 ; bill debtor
SET PRCADB=$PIECE(RCY,"^",9)
+22 ;not a 1st party bill
IF $PIECE($GET(^RCD(340,PRCADB,0)),U)'[";DPT("
QUIT
+23 SET RCDT=+$PIECE(RCY,"^",10)
+24 SET ^TMP("PRCAHV",$JOB,RCDT,RCS,RCX)=$GET(^TMP("PRCAAPR",$JOB,"C",RCS,RCX))
End DoDot:2
End DoDot:1
+25 KILL ^TMP("PRCAAPR",$JOB)
+26 ;
+27 SET (RCC,RCDT)=0
FOR
SET RCDT=$ORDER(^TMP("PRCAHV",$JOB,RCDT))
if 'RCDT
QUIT
Begin DoDot:1
+28 SET RCS=0
FOR
SET RCS=$ORDER(^TMP("PRCAHV",$JOB,RCDT,RCS))
if 'RCS
QUIT
Begin DoDot:2
+29 SET RCX=0
FOR
SET RCX=$ORDER(^TMP("PRCAHV",$JOB,RCDT,RCS,RCX))
if 'RCX
QUIT
Begin DoDot:3
+30 NEW RCDESC
+31 DO BILLDESC^RCCPCPS1(RCX)
+32 SET RCB=0
SET RCZ=$GET(^TMP("PRCAHV",$JOB,RCDT,RCS,RCX))
+33 FOR RCP=1:1:5
SET RCB=RCB+$PIECE(RCZ,U,RCP)
+34 SET RCY=^PRCA(430,RCX,0)
+35 SET RCC=RCC+1
SET RESULT(RCC)=$PIECE(RCY,U)_U_$PIECE(RCY,U,10)_U_RCDESC(1)_U_RCB_U_RCS
End DoDot:3
End DoDot:2
End DoDot:1
+36 ;
+37 KILL ^TMP("PRCAHV",$JOB)
+38 ;Success, data not guaranteed
QUIT 1
+39 ;
+40 ;Function: Transaction details
+41 ;Input: RCBILL - Bill IEN
+42 ;Output: 1-success, 0-no data, '-1'-no parameter '-2'-the bill doesn't exist, '-3'-program error
+43 ; RESULT(i)=<Trans.No>^<Date(FM)>^<Trans.Type>^<reserved>^<Trans. amount>^<Descr1>^<Descr2>^<Descr3>^<Descr4>^<Descr5>
+44 ; RESULT may be undefined if error or no data
INTTRANS(RESULT,RCBILL) ; returns transaction details for the given bill IEN
+1 NEW RCTRAN,RCNUM,X,Y,C
+2 KILL RESULT
+3 SET X="ERROR^PRCAHV"
SET @^%ZOSF("TRAP")
+4 if '$DATA(U)
SET U="^"
+5 ;Bad parameter
IF $GET(RCBILL)=""
QUIT -1
+6 ;The bill doesn't exist
IF '$DATA(^PRCA(430,RCBILL,0))
QUIT -2
+7 ;No data
IF '$DATA(^PRCA(433,"C",RCBILL))
QUIT 0
+8 SET (RCNUM,RCTRAN)=0
FOR
SET RCTRAN=$ORDER(^PRCA(433,"C",RCBILL,RCTRAN))
if 'RCTRAN
QUIT
Begin DoDot:1
+9 ;Corrupted cross-reference
if '$DATA(^PRCA(433,RCTRAN,0))
QUIT
+10 NEW RCDESC,RCTOTAL,RCY,RCI,RCTXT,RCD,RCTTY,RCAMT
+11 DO TRANDESC^RCCPCPS1(RCTRAN)
+12 SET RCY=$GET(^PRCA(433,RCTRAN,1))
+13 ; Transaction Type
SET RCTTY=$PIECE(RCY,U,2)
+14 ; Transaction Amount
SET RCAMT=$PIECE(RCY,U,5)
+15 IF ",2,8,9,10,11,14,19,47,34,35,29,"[(","_RCTTY_",")
IF RCAMT'<0
SET RCAMT=-RCAMT
+16 IF ",2,8,9,10,11,12,14,19,47,34,35,29,"'[(","_RCTTY_",")
IF RCAMT<0
SET RCAMT=-RCAMT
+17 ;S RCTXT=RCTRAN_U_$P(RCY,U)_U_$G(RCTOTAL("INT"))_U_$G(RCTOTAL("ADM"))_U_$P(RCY,U,5)
+18 SET RCTXT=RCTRAN_U_$PIECE(RCY,U)_U_RCTTY_U_U_RCAMT
+19 SET RCI=0
FOR
SET RCI=$ORDER(RCDESC(RCI))
if 'RCI
QUIT
SET RCD=$$TRIM(RCDESC(RCI))
if ($LENGTH(RCD)+$LENGTH(RCTXT))>254
QUIT
SET RCTXT=RCTXT_U_RCD
+20 SET RCNUM=RCNUM+1
+21 SET RESULT(RCNUM)=RCTXT
End DoDot:1
+22 ;
+23 ;Success, data not guaranteed
QUIT 1
+24 ;
TRIM(RCTXT) ;Remove starting and ending spaces
+1 NEW RCI,RES
+2 SET RES=RCTXT
+3 FOR RCI=1:1:$LENGTH(RES)
if $EXTRACT(RES,RCI)'=" "
QUIT
+4 IF RCI>1
SET $EXTRACT(RES,1,RCI-1)=""
+5 FOR RCI=$LENGTH(RES):-1:1
if $EXTRACT(RES,RCI)'=" "
QUIT
+6 IF RCI<$LENGTH(RES)
SET $EXTRACT(RES,RCI+1,$LENGTH(RES))=""
+7 QUIT RES
+8 ;
+9 ;Adjust Account Receivable Transaction Type:
+10 ;1) Convert to upper case
+11 ;2) Undefined will became "OPEN"
+12 ;3) OPEN will became "113,112,102,107"
ADJTYPE(RCTYPE) ;
+1 ; Convert tp upper case
SET RCTYPE=$TRANSLATE($GET(RCTYPE,"OPEN"),"openal ","OPENAL")
+2 IF RCTYPE="OPEN"
SET RCTYPE="113,112,102,107"
+3 QUIT
+4 ;
+5 ;Program error trap
ERROR QUIT -3
+1 ;
+2 ;Temporary entry points - test only! Will be removed after testing
TEST NEW C,R,P,A,O
+1 SET (P,C)=0
FOR
SET P=$ORDER(^DPT("AICN",P))
if 'P
QUIT
SET R=$$DETAIL(.O,P,"ALL")
IF R>0
IF $DATA(O)
WRITE !,P,?20,R,!
DO TESTZW(.O)
SET C=C+1
if C>500
QUIT
+2 QUIT
+3 ;
TEST2 NEW C,R,P,A
+1 SET (P,C)=0
FOR
SET P=$ORDER(^PRCA(430,"B",P))
if 'P
QUIT
SET R=$$TRANS(.A,P)
IF R
WRITE !,P,?20,R,!
IF $DATA(A)
DO TESTZW(.A)
SET C=C+1
if C>500
QUIT
+2 QUIT
TESTZW(PRA) NEW RCI
+1 SET RCI=""
FOR
SET RCI=$ORDER(PRA(RCI))
if 'RCI
QUIT
WRITE !,RCI,?10,PRA(RCI)
+2 QUIT
