- 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 Feb 18, 2025@23:08:33 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
