RCEVUTL ;WASH-ISC@ALTOONA,PA/RGY-Generic Event Utilities ;5/6/96 8:15 AM
V ;;4.5;Accounts Receivable;42;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
DEBT(DEB) ;Return or add Debtor to debtor file
NEW DIC,DLAYGO,X,Y
S DEB=$G(DEB) I "^DPT(^DIC(36^DIC(4^PRC(440^VA(200^"'[("^"_$P($S(DEB'[";DPT(":$E(DEB,1,$L(DEB)-1),1:DEB),";",2)_"^") S DEB=-1 G Q1
I '$D(@("^"_$P(DEB,";",2)_(+DEB)_",0)")) S DEB=-1 G Q1
I '$O(^RCD(340,"B",DEB,0)) K DD,D0 S DIC="^RCD(340,",DLAYGO=340,X=DEB,DIC(0)="L" D FILE^DICN K D0 S DEB=$S(+Y>0:+Y,1:-1) G Q1
S DEB=$O(^RCD(340,"B",DEB,0)) S:'DEB DEB=-1
Q1 Q DEB
EFF(TRAN) ;Return effect on balance
S TRAN=$P($G(^RC(341.1,+$P($G(^RC(341,+$G(TRAN),0)),"^",2),0)),"^",3) S:TRAN="" TRAN=-1
Q3 Q TRAN
BAL(DEBT) ;Return amount owed by debtor
S Y="" G:'$D(DEBT) Q4
S:DEBT?1N.N1";"1A.A1"(" DEBT=$O(^RCD(340,"B",DEBT,0))
S Y=$P($G(^RC(341,+$P($G(^RCD(340,DEBT,0)),"^",2),1)),"^",6,10)
Q4 Q Y
OVD(TRAN) ;Return effect on overdue
S TRAN=$P($G(^RC(341.1,+$P($G(^RC(341,+$G(TRAN),0)),"^",2),0)),"^",5) S:TRAN="" TRAN=-1
Q TRAN
BILT(BILL) ;Return amount of bill
I $G(BILL)'?1N.N Q 0
I $G(^PRCA(430,BILL,0))="" Q 0
S X=$P($G(^PRCA(430,BILL,7)),"^",1,5)
S $P(X,"^",6)=$P(X,"^")+$P(X,"^",2)+$P(X,"^",3)+$P(X,"^",4)+$P(X,"^",5)
Q X
BALO(DEBT) ;Return overdue amount for a debtor
S Y="" G:'$D(DEBT) Q5
S:DEBT?1N.N1";"1A.A1"(" DEBT=$O(^RCD(340,"B",DEBT,0))
S Y=$P($G(^RC(341,+$P($G(^RCD(340,DEBT,0)),"^",2),1)),"^",11,15)
Q5 Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCEVUTL 1516 printed Dec 13, 2024@01:46:48 Page 2
RCEVUTL ;WASH-ISC@ALTOONA,PA/RGY-Generic Event Utilities ;5/6/96 8:15 AM
V ;;4.5;Accounts Receivable;42;Mar 20, 1995
+1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
DEBT(DEB) ;Return or add Debtor to debtor file
+1 NEW DIC,DLAYGO,X,Y
+2 SET DEB=$GET(DEB)
IF "^DPT(^DIC(36^DIC(4^PRC(440^VA(200^"'[("^"_$PIECE($SELECT(DEB'[";DPT(":$EXTRACT(DEB,1,$LENGTH(DEB)-1),1:DEB),";",2)_"^")
SET DEB=-1
GOTO Q1
+3 IF '$DATA(@("^"_$PIECE(DEB,";",2)_(+DEB)_",0)"))
SET DEB=-1
GOTO Q1
+4 IF '$ORDER(^RCD(340,"B",DEB,0))
KILL DD,D0
SET DIC="^RCD(340,"
SET DLAYGO=340
SET X=DEB
SET DIC(0)="L"
DO FILE^DICN
KILL D0
SET DEB=$SELECT(+Y>0:+Y,1:-1)
GOTO Q1
+5 SET DEB=$ORDER(^RCD(340,"B",DEB,0))
if 'DEB
SET DEB=-1
Q1 QUIT DEB
EFF(TRAN) ;Return effect on balance
+1 SET TRAN=$PIECE($GET(^RC(341.1,+$PIECE($GET(^RC(341,+$GET(TRAN),0)),"^",2),0)),"^",3)
if TRAN=""
SET TRAN=-1
Q3 QUIT TRAN
BAL(DEBT) ;Return amount owed by debtor
+1 SET Y=""
if '$DATA(DEBT)
GOTO Q4
+2 if DEBT?1N.N1";"1A.A1"("
SET DEBT=$ORDER(^RCD(340,"B",DEBT,0))
+3 SET Y=$PIECE($GET(^RC(341,+$PIECE($GET(^RCD(340,DEBT,0)),"^",2),1)),"^",6,10)
Q4 QUIT Y
OVD(TRAN) ;Return effect on overdue
+1 SET TRAN=$PIECE($GET(^RC(341.1,+$PIECE($GET(^RC(341,+$GET(TRAN),0)),"^",2),0)),"^",5)
if TRAN=""
SET TRAN=-1
+2 QUIT TRAN
BILT(BILL) ;Return amount of bill
+1 IF $GET(BILL)'?1N.N
QUIT 0
+2 IF $GET(^PRCA(430,BILL,0))=""
QUIT 0
+3 SET X=$PIECE($GET(^PRCA(430,BILL,7)),"^",1,5)
+4 SET $PIECE(X,"^",6)=$PIECE(X,"^")+$PIECE(X,"^",2)+$PIECE(X,"^",3)+$PIECE(X,"^",4)+$PIECE(X,"^",5)
+5 QUIT X
BALO(DEBT) ;Return overdue amount for a debtor
+1 SET Y=""
if '$DATA(DEBT)
GOTO Q5
+2 if DEBT?1N.N1";"1A.A1"("
SET DEBT=$ORDER(^RCD(340,"B",DEBT,0))
+3 SET Y=$PIECE($GET(^RC(341,+$PIECE($GET(^RCD(340,DEBT,0)),"^",2),1)),"^",11,15)
Q5 QUIT Y
