- 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 Feb 18, 2025@23:06:16 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