PRCAX1.m

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 ---PRCAX1   1421     printed  Apr 09, 2024@20:44:54                                                                                                                                                                                                      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