VistA-WorldVistAEHR/r/ACCOUNTS_RECEIVABLE-PRCA-PR.../PRCAX1.m

17 lines
1.4 KiB
Mathematica

PRCAX1 ;WASH-ISC@ALTOONA,PA/LDB-MEDICATION COPAY EXEMPTION (CONT.) ;7/20/93 1:09 PM
V ;;4.5;Accounts Receivable;;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
;
AUDIT ;ADDS COMMENTS DETAILING BILLS W/EXEMPTED AMOUNTS
S DECAMT1=$S($G(TRAMT):TRAMT,$G(DECAMT):DECAMT,1:$G(BUCKET)),MSGCNT=2
I $D(^TMP($J,"BUCKET",+BILL)),DECAMT1=^(BILL),(",16,42,"[(","_STATUS_",")) K ^(BILL) Q
I $D(^TMP($J,"BUCKET",+BILL)) S ^TMP($J,"BUCKET",+BILL)=^TMP($J,"BUCKET",+BILL)-DECAMT1 Q
S BILLN=0 F S BILLN=$O(^TMP($J,"BUCKET",BILLN)) Q:'BILLN D
.I ^TMP($J,"BUCKET",BILLN)'>DECAMT1 S DECAMT1=DECAMT1-^TMP($J,"BUCKET",BILLN),MSG(MSGCNT)="FROM BILL# "_$P($G(^PRCA(430,+BILLN,0)),"^")_" IN THE AMOUNT OF "_$J(^TMP($J,"BUCKET",BILLN),12,2),MSGCNT=MSGCNT+1 K ^TMP($J,"BUCKET",BILLN) Q
.I DECAMT1,^TMP($J,"BUCKET",BILLN)>DECAMT1 S ^TMP($J,"BUCKET",BILLN)=^TMP($J,"BUCKET",BILLN)-DECAMT1,MSG(MSGCNT)="FROM BILL# "_$P($G(^PRCA(430,BILLN,0)),"^")_" IN THE AMOUNT OF "_$J(DECAMT1,12,2),DECAMT1=DECAMT1-DECAMT1,MSGCNT=MSGCNT+1
S MSGCNTS=MSGCNT
I DIE[433,$O(MSG(0)) S ^PRCA(433,DA,7,0)="^^"_MSGCNTS_"^"_MSGCNTS,MSGCNT=0 F S MSGCNT=$O(MSG(MSGCNT)) Q:'MSGCNT S ^PRCA(433,DA,7,MSGCNT,0)=MSG(MSGCNT)
I DIE[430,$O(MSG(0)) S ^PRCA(430,DA,10,0)="^^"_MSGCNTS_"^"_MSGCNTS,MSGCNT=0 F S MSGCNT=$O(MSG(MSGCNT)) Q:'MSGCNT S ^PRCA(430,DA,10,MSGCNT,0)=MSG(MSGCNT)
K DA,DECAMT1,DIE,DR,MSG,MSGCNT Q