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 ---[H[J[2J[HPRCAI103 1249 printed Nov 22, 2024@16:50:06 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
