PRYAUP.m

PRYAUP ;WASH-ISC@ALTOONA,PA/LDB- CHAMPVA AR DEBT LIST ;4/6/95  4:36 PM

V ;;4.5;Accounts Receivable;**1**;Mar 20, 1995

 ;Add entry to AR DEBT LIST

 N DA,DIC,DIE,DR,X,Y

 I $D(^PRCA(430.6,"B","CHMPV")) Q

 S DIC="^PRCA(430.6,",DIC(0)="L",X="CHMPV",DLAYGO=430.6

 D ^DIC Q:Y<0

 S DA=+Y

 S DIE=DIC,DR="1////^S X="_"""CHAMPVA SUBSISTENCE"""_";3////^S X="_"""CP"""

 D ^DIE

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRYAUP   378     printed  Dec 13, 2024@01:42:11                                                                                                                                                                                                       Page 2

PRYAUP    ;WASH-ISC@ALTOONA,PA/LDB- CHAMPVA AR DEBT LIST ;4/6/95  4:36 PM

V         ;;4.5;Accounts Receivable;**1**;Mar 20, 1995

 +1       ;Add entry to AR DEBT LIST

 +2        NEW DA,DIC,DIE,DR,X,Y

 +3        IF $DATA(^PRCA(430.6,"B","CHMPV"))

               QUIT 

 +4        SET DIC="^PRCA(430.6,"

           SET DIC(0)="L"

           SET X="CHMPV"

           SET DLAYGO=430.6

 +5        DO ^DIC

           if Y<0

               QUIT 

 +6        SET DA=+Y

 +7        SET DIE=DIC

           SET DR="1////^S X="_"""CHAMPVA SUBSISTENCE"""_";3////^S X="_"""CP"""

 +8        DO ^DIE

 +9        QUIT