Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCAHV

PRCAHV.m

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