source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCAX1.m@ 619

Last change on this file since 619 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.4 KB
Line 
1PRCAX1 ;WASH-ISC@ALTOONA,PA/LDB-MEDICATION COPAY EXEMPTION (CONT.) ;7/20/93 1:09 PM
2V ;;4.5;Accounts Receivable;;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;
6AUDIT ;ADDS COMMENTS DETAILING BILLS W/EXEMPTED AMOUNTS
7 S DECAMT1=$S($G(TRAMT):TRAMT,$G(DECAMT):DECAMT,1:$G(BUCKET)),MSGCNT=2
8 I $D(^TMP($J,"BUCKET",+BILL)),DECAMT1=^(BILL),(",16,42,"[(","_STATUS_",")) K ^(BILL) Q
9 I $D(^TMP($J,"BUCKET",+BILL)) S ^TMP($J,"BUCKET",+BILL)=^TMP($J,"BUCKET",+BILL)-DECAMT1 Q
10 S BILLN=0 F S BILLN=$O(^TMP($J,"BUCKET",BILLN)) Q:'BILLN D
11 .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
12 .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
13 S MSGCNTS=MSGCNT
14 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)
15 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)
16 K DA,DECAMT1,DIE,DR,MSG,MSGCNT Q
Note: See TracBrowser for help on using the repository browser.