PRCAI103.m

PRCAI103 ;WISC/RFJ-post init patch 103 ;1 Mar 97

 ;;4.5;Accounts Receivable;**103**;Mar 20, 1995

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

 Q

 ;

 ;

START ;  start post init

 N DATA3,DATE,TRANDA

 ;  for exempt int/adm charge transactions (entry = 14)

 S DATE=0 F  S DATE=$O(^PRCA(433,"AT",14,DATE)) Q:'DATE  D

 .   S TRANDA=0 F  S TRANDA=$O(^PRCA(433,"AT",14,DATE,TRANDA)) Q:'TRANDA  D

 .   .   L +^PRCA(433,TRANDA)

 .   .   ;

 .   .   S DATA3=$G(^PRCA(433,TRANDA,3))

 .   .   ;  if there is interest collected (field 32),

 .   .   ;  move to interest charge (field 27)

 .   .   I $P(DATA3,"^",2) D

 .   .   .   S $P(^PRCA(433,TRANDA,2),"^",7)=$P(DATA3,"^",2)

 .   .   .   S $P(^PRCA(433,TRANDA,3),"^",2)=""

 .   .   ;  if there is admin collected (field 33),

 .   .   ;  move to admin charge (field 28)

 .   .   I $P(DATA3,"^",3) D

 .   .   .   S $P(^PRCA(433,TRANDA,2),"^",8)=$P(DATA3,"^",3)

 .   .   .   S $P(^PRCA(433,TRANDA,3),"^",3)=""

 .   .   ;

 .   .   L -^PRCA(433,TRANDA)

 ;

 ;  if the patch is installed after the 20th of the month

 ;  send the responses to the messages which will be deleted

 ;  on the first of the month (by routine RCRJR)

 I $E(DT,6,7)>20 D CLEANXMB^RCRJR

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCAI103   1249     printed  Mar 13, 2025@20:44:34                                                                                                                                                                                                    Page 2

PRCAI103  ;WISC/RFJ-post init patch 103 ;1 Mar 97

 +1       ;;4.5;Accounts Receivable;**103**;Mar 20, 1995

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

 +3        QUIT 

 +4       ;

 +5       ;

START     ;  start post init

 +1        NEW DATA3,DATE,TRANDA

 +2       ;  for exempt int/adm charge transactions (entry = 14)

 +3        SET DATE=0

           FOR 

               SET DATE=$ORDER(^PRCA(433,"AT",14,DATE))

               if 'DATE

                   QUIT 

               Begin DoDot:1

 +4                SET TRANDA=0

                   FOR 

                       SET TRANDA=$ORDER(^PRCA(433,"AT",14,DATE,TRANDA))

                       if 'TRANDA

                           QUIT 

                       Begin DoDot:2

 +5                        LOCK +^PRCA(433,TRANDA)

 +6       ;

 +7                        SET DATA3=$GET(^PRCA(433,TRANDA,3))

 +8       ;  if there is interest collected (field 32),

 +9       ;  move to interest charge (field 27)

 +10                       IF $PIECE(DATA3,"^",2)

                               Begin DoDot:3

 +11                               SET $PIECE(^PRCA(433,TRANDA,2),"^",7)=$PIECE(DATA3,"^",2)

 +12                               SET $PIECE(^PRCA(433,TRANDA,3),"^",2)=""

                               End DoDot:3

 +13      ;  if there is admin collected (field 33),

 +14      ;  move to admin charge (field 28)

 +15                       IF $PIECE(DATA3,"^",3)

                               Begin DoDot:3

 +16                               SET $PIECE(^PRCA(433,TRANDA,2),"^",8)=$PIECE(DATA3,"^",3)

 +17                               SET $PIECE(^PRCA(433,TRANDA,3),"^",3)=""

                               End DoDot:3

 +18      ;

 +19                       LOCK -^PRCA(433,TRANDA)

                       End DoDot:2

               End DoDot:1

 +20      ;

 +21      ;  if the patch is installed after the 20th of the month

 +22      ;  send the responses to the messages which will be deleted

 +23      ;  on the first of the month (by routine RCRJR)

 +24       IF $EXTRACT(DT,6,7)>20

               DO CLEANXMB^RCRJR

 +25       QUIT