RCEVUTL.m

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 ---RCEVUTL   1516     printed  Apr 09, 2024@20:54:40                                                                                                                                                                                                     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