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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCAX1 1421 printed Nov 22, 2024@16:52:22 Page 2
PRCAX1 ;WASH-ISC@ALTOONA,PA/LDB-MEDICATION COPAY EXEMPTION (CONT.) ;7/20/93 1:09 PM
V ;;4.5;Accounts Receivable;;Mar 20, 1995
+1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;
+3 ;
AUDIT ;ADDS COMMENTS DETAILING BILLS W/EXEMPTED AMOUNTS
+1 SET DECAMT1=$SELECT($GET(TRAMT):TRAMT,$GET(DECAMT):DECAMT,1:$GET(BUCKET))
SET MSGCNT=2
+2 IF $DATA(^TMP($JOB,"BUCKET",+BILL))
IF DECAMT1=^(BILL)
IF (",16,42,"[(","_STATUS_","))
KILL ^(BILL)
QUIT
+3 IF $DATA(^TMP($JOB,"BUCKET",+BILL))
SET ^TMP($JOB,"BUCKET",+BILL)=^TMP($JOB,"BUCKET",+BILL)-DECAMT1
QUIT
+4 SET BILLN=0
FOR
SET BILLN=$ORDER(^TMP($JOB,"BUCKET",BILLN))
if 'BILLN
QUIT
Begin DoDot:1
+5 IF ^TMP($JOB,"BUCKET",BILLN)'>DECAMT1
SET DECAMT1=DECAMT1-^TMP($JOB,"BUCKET",BILLN)
SET MSG(MSGCNT)="FROM BILL# "_$PIECE($GET(^PRCA(430,+BILLN,0)),"^")_" IN THE AMOUNT OF "_$JUSTIFY(^TMP($JOB,"BUCKET",BILLN),12,2)
SET MSGCNT=MSGCNT+1
KILL ^TMP($JOB,"BUCKET",BILLN)
QUIT
+6 IF DECAMT1
IF ^TMP($JOB,"BUCKET",BILLN)>DECAMT1
SET ^TMP($JOB,"BUCKET",BILLN)=^TMP($JOB,"BUCKET",BILLN)-DECAMT1
SET MSG(MSGCNT)="FROM BILL# "_$PIECE($GET(^PRCA(430,BILLN,0)),"^")_" IN THE AMOUNT OF "_$JUSTIFY(DECAMT1,12,2)
SET DECAMT1=DECAMT1-DECAMT1
SET MSGCNT=MSGCNT+1
End DoDot:1
+7 SET MSGCNTS=MSGCNT
+8 IF DIE[433
IF $ORDER(MSG(0))
SET ^PRCA(433,DA,7,0)="^^"_MSGCNTS_"^"_MSGCNTS
SET MSGCNT=0
FOR
SET MSGCNT=$ORDER(MSG(MSGCNT))
if 'MSGCNT
QUIT
SET ^PRCA(433,DA,7,MSGCNT,0)=MSG(MSGCNT)
+9 IF DIE[430
IF $ORDER(MSG(0))
SET ^PRCA(430,DA,10,0)="^^"_MSGCNTS_"^"_MSGCNTS
SET MSGCNT=0
FOR
SET MSGCNT=$ORDER(MSG(MSGCNT))
if 'MSGCNT
QUIT
SET ^PRCA(430,DA,10,MSGCNT,0)=MSG(MSGCNT)
+10 KILL DA,DECAMT1,DIE,DR,MSG,MSGCNT
QUIT
