RCTCSPD5 ;ALB/LMH-CROSS-SERVICING NON-FINANCIAL TRANSACTIONS ;03/15/14 3:34 PM
;;4.5;Accounts Receivable;**315,339,366,369**;Mar 20, 1995;Build 15
;;Per VA Directive 6402, this routine should not be modified.
;
;PRCA*4.5*366 Modify .03 pointer stuff to '////' in DR string
;PRCA*4.5*369 Add text transaction for auto recall <$25
Q
;
CSATRY ; Cross-Servicing Admin Adj Treasury Rev? Yes non-financial tx
N PRCAEN,PRCAA1,DR,DIE,DA,D0,PRCAD,RCASK,PRCAA2,PRCA,PRCATY,RCUSER,X
D SETTR^PRCAUTL,PATTR^PRCAUTL Q:'$D(PRCAEN)
S PRCAA1=$S($D(^PRCA(433,PRCAEN,4,0)):+$P(^(0),U,4),1:0)
Q:PRCAA1'>0 S PRCAA2=$P(^(0),U,3)
S DIE="^PRCA(433,",DA=PRCAEN
S DR=".03////"_PRCABN ;Bill Number
S DR=DR_";3///0" ;Calm Code Done
S DR=DR_";12///"_$O(^PRCA(430.3,"AC",53,0)) ;Transaction Type
S DR=DR_";15///0" ;Transaction Amount
S DR=DR_";42///"_DUZ ;Processed by user
S DR=DR_";11///"_DT ;Transaction date
S DR=DR_";4///2" ;Transaction status (complete)
S DR=DR_";5.02///CS ADMIN ADJ TR REV?Y" D ^DIE
Q
;
CSATRN ; Cross-Servicing Admin Adj Treasury Rev? No non-financial tx
N PRCAEN,PRCAA1,DR,DIE,DA,D0,PRCAD,RCASK,PRCAA2,PRCA,PRCATY,RCUSER,X
D SETTR^PRCAUTL,PATTR^PRCAUTL Q:'$D(PRCAEN)
S PRCAA1=$S($D(^PRCA(433,PRCAEN,4,0)):+$P(^(0),U,4),1:0)
Q:PRCAA1'>0 S PRCAA2=$P(^(0),U,3)
S DIE="^PRCA(433,",DA=PRCAEN
S DR=".03////"_PRCABN ;Bill Number
S DR=DR_";3///0" ;Calm Code Done
S DR=DR_";12///"_$O(^PRCA(430.3,"AC",54,0)) ;Transaction Type
S DR=DR_";15///0" ;Transaction Amount
S DR=DR_";42///"_DUZ ;Processed by user
S DR=DR_";11///"_DT ;Transaction date
S DR=DR_";4///2" ;Transaction status (complete)
S DR=DR_";5.02///CS ADMIN ADJ TR REV?N" D ^DIE
Q
;
CSITRY ; Cross-Servicing Incr Adj Treasury Rev? Yes non-financial tx
N PRCAEN,PRCAA1,DR,DIE,DA,D0,PRCAD,RCASK,PRCAA2,PRCA,PRCATY,RCUSER,X
D SETTR^PRCAUTL,PATTR^PRCAUTL Q:'$D(PRCAEN)
S PRCAA1=$S($D(^PRCA(433,PRCAEN,4,0)):+$P(^(0),U,4),1:0)
Q:PRCAA1'>0 S PRCAA2=$P(^(0),U,3)
S DIE="^PRCA(433,",DA=PRCAEN
S DR=".03////"_PRCABN ;Bill Number
S DR=DR_";3///0" ;Calm Code Done
S DR=DR_";12///"_$O(^PRCA(430.3,"AC",57,0)) ;Transaction Type
S DR=DR_";15///0" ;Transaction Amount
S DR=DR_";42///"_DUZ ;Processed by user
S DR=DR_";11///"_DT ;Transaction date
S DR=DR_";4///2" ;Transaction status (complete)
S DR=DR_";5.02///CS INC ADJ TR REV?Y" D ^DIE
Q
;
CSITRN ; Cross-Servicing Incr Adj Treasury Rev? No non-financial tx
N PRCAEN,PRCAA1,DR,DIE,DA,D0,PRCAD,RCASK,PRCAA2,PRCA,PRCATY,RCUSER,X
D SETTR^PRCAUTL,PATTR^PRCAUTL Q:'$D(PRCAEN)
S PRCAA1=$S($D(^PRCA(433,PRCAEN,4,0)):+$P(^(0),U,4),1:0)
Q:PRCAA1'>0 S PRCAA2=$P(^(0),U,3)
S DIE="^PRCA(433,",DA=PRCAEN
S DR=".03////"_PRCABN ;Bill Number
S DR=DR_";3///0" ;Calm Code Done
S DR=DR_";12///"_$O(^PRCA(430.3,"AC",58,0)) ;Transaction Type
S DR=DR_";15///0" ;Transaction Amount
S DR=DR_";42///"_DUZ ;Processed by user
S DR=DR_";11///"_DT ;Transaction date
S DR=DR_";4///2" ;Transaction status (complete)
S DR=DR_";5.02///CS INC ADJ TR REV?N" D ^DIE
Q
;
CSPRTR ; Cross-Servicing PENDING RECONCILIATION non-financial tx
; Called by R1^RCTCSPRS
N PRCAEN,PRCAA1,DR,DIE,DA,D0,PRCAD,RCASK,PRCAA2,PRCA,PRCATY,RCUSER,DUZ
; DUZ is reserved, but in this case DUZ may be undefined due to a server background job, but we don't want to overwrite DUZ if it exists
S PRCABN=BILL,DUZ=.5,DUZ(0)="@",DUZ(2)=1 ; Server has no DUZ, use Postmaster
D SETTR^PRCAUTL,PATTR^PRCAUTL Q:'$D(PRCAEN)
S PRCAA1=$S($D(^PRCA(433,PRCAEN,4,0)):+$P(^(0),U,4),1:0)
Q:PRCAA1'>0 S PRCAA2=$P(^(0),U,3)
S DIE="^PRCA(433,",DA=PRCAEN
S DR=".03////"_PRCABN ;Bill Number
S DR=DR_";3///0" ;Calm Code Done
S DR=DR_";12///"_$O(^PRCA(430.3,"AC",61,0)) ;Transaction Type
S DR=DR_";15///0" ;Transaction Amount
S DR=DR_";42///"_DUZ ;Processed by user
S DR=DR_";11///"_DT ;Transaction date
S DR=DR_";4///2" ;Transaction status (complete)
S DR=DR_";5.02///CS PEND RECON" D ^DIE
Q
;
CSRCLPL ; CS RECALL placed non-financial tx
N PRCAEN,PRCAA1,DR,DIE,DA,D0,PRCAD,RCASK,PRCAA2,PRCA,PRCATY,RCUSER
S PRCABN=BILL
D SETTR^PRCAUTL,PATTR^PRCAUTL Q:'$D(PRCAEN)
S PRCAA1=$S($D(^PRCA(433,PRCAEN,4,0)):+$P(^(0),U,4),1:0)
Q:PRCAA1'>0 S PRCAA2=$P(^(0),U,3)
S DIE="^PRCA(433,",DA=PRCAEN
S DR=".03////"_PRCABN ;Bill Number
S DR=DR_";3///0" ;Calm Code Done
S DR=DR_";12///"_$O(^PRCA(430.3,"AC",62,0)) ;Transaction Type
S DR=DR_";15///0" ;Transaction Amount
S DR=DR_";42///"_DUZ ;Processed by user
S DR=DR_";11///"_DT ;Transaction date
S DR=DR_";4///2" ;Transaction status (complete)
S DR=DR_";5.02///CS RECALL PLACED" D ^DIE
Q
CSAUTORC ; Recall from Cross-Servicing non-financial tx ;PRCA*4.5*369
N PRCAEN,PRCAA1,DR,DIE,DA,D0,PRCAD,RCASK,PRCAA2,PRCA,PRCATY,RCUSER,DUZ
;DUZ is reserved, but in this case DUZ may be undefined due to batch background job
S PRCABN=BILL,DUZ=.5,DUZ(0)="@",DUZ(2)=1 ; Server has no DUZ, use Postmaster
D SETTR^PRCAUTL,PATTR^PRCAUTL Q:'$D(PRCAEN)
S PRCAA1=$S($D(^PRCA(433,PRCAEN,4,0)):+$P(^(0),U,4),1:0)
Q:PRCAA1'>0 S PRCAA2=$P(^(0),U,3)
S DIE="^PRCA(433,",DA=PRCAEN
S DR=".03////"_PRCABN ;Bill Number
S DR=DR_";3///0" ;Calm Code Done
S DR=DR_";12///"_$O(^PRCA(430.3,"AC",66,0)) ;Transaction Type
S DR=DR_";15///0" ;Transaction Amount
S DR=DR_";42///"_DUZ ;Processed by user
S DR=DR_";11///"_DT ;Transaction date
S DR=DR_";4///2" ;Transaction status (complete)
S DR=DR_";5.02///CS AUTO RECALL BILL <$25" D ^DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCTCSPD5 5489 printed Oct 14, 2021@15:14:39 Page 2
RCTCSPD5 ;ALB/LMH-CROSS-SERVICING NON-FINANCIAL TRANSACTIONS ;03/15/14 3:34 PM
+1 ;;4.5;Accounts Receivable;**315,339,366,369**;Mar 20, 1995;Build 15
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;PRCA*4.5*366 Modify .03 pointer stuff to '////' in DR string
+5 ;PRCA*4.5*369 Add text transaction for auto recall <$25
+6 QUIT
+7 ;
CSATRY ; Cross-Servicing Admin Adj Treasury Rev? Yes non-financial tx
+1 NEW PRCAEN,PRCAA1,DR,DIE,DA,D0,PRCAD,RCASK,PRCAA2,PRCA,PRCATY,RCUSER,X
+2 DO SETTR^PRCAUTL
DO PATTR^PRCAUTL
if '$DATA(PRCAEN)
QUIT
+3 SET PRCAA1=$SELECT($DATA(^PRCA(433,PRCAEN,4,0)):+$PIECE(^(0),U,4),1:0)
+4 if PRCAA1'>0
QUIT
SET PRCAA2=$PIECE(^(0),U,3)
+5 SET DIE="^PRCA(433,"
SET DA=PRCAEN
+6 ;Bill Number
SET DR=".03////"_PRCABN
+7 ;Calm Code Done
SET DR=DR_";3///0"
+8 ;Transaction Type
SET DR=DR_";12///"_$ORDER(^PRCA(430.3,"AC",53,0))
+9 ;Transaction Amount
SET DR=DR_";15///0"
+10 ;Processed by user
SET DR=DR_";42///"_DUZ
+11 ;Transaction date
SET DR=DR_";11///"_DT
+12 ;Transaction status (complete)
SET DR=DR_";4///2"
+13 SET DR=DR_";5.02///CS ADMIN ADJ TR REV?Y"
DO ^DIE
+14 QUIT
+15 ;
CSATRN ; Cross-Servicing Admin Adj Treasury Rev? No non-financial tx
+1 NEW PRCAEN,PRCAA1,DR,DIE,DA,D0,PRCAD,RCASK,PRCAA2,PRCA,PRCATY,RCUSER,X
+2 DO SETTR^PRCAUTL
DO PATTR^PRCAUTL
if '$DATA(PRCAEN)
QUIT
+3 SET PRCAA1=$SELECT($DATA(^PRCA(433,PRCAEN,4,0)):+$PIECE(^(0),U,4),1:0)
+4 if PRCAA1'>0
QUIT
SET PRCAA2=$PIECE(^(0),U,3)
+5 SET DIE="^PRCA(433,"
SET DA=PRCAEN
+6 ;Bill Number
SET DR=".03////"_PRCABN
+7 ;Calm Code Done
SET DR=DR_";3///0"
+8 ;Transaction Type
SET DR=DR_";12///"_$ORDER(^PRCA(430.3,"AC",54,0))
+9 ;Transaction Amount
SET DR=DR_";15///0"
+10 ;Processed by user
SET DR=DR_";42///"_DUZ
+11 ;Transaction date
SET DR=DR_";11///"_DT
+12 ;Transaction status (complete)
SET DR=DR_";4///2"
+13 SET DR=DR_";5.02///CS ADMIN ADJ TR REV?N"
DO ^DIE
+14 QUIT
+15 ;
CSITRY ; Cross-Servicing Incr Adj Treasury Rev? Yes non-financial tx
+1 NEW PRCAEN,PRCAA1,DR,DIE,DA,D0,PRCAD,RCASK,PRCAA2,PRCA,PRCATY,RCUSER,X
+2 DO SETTR^PRCAUTL
DO PATTR^PRCAUTL
if '$DATA(PRCAEN)
QUIT
+3 SET PRCAA1=$SELECT($DATA(^PRCA(433,PRCAEN,4,0)):+$PIECE(^(0),U,4),1:0)
+4 if PRCAA1'>0
QUIT
SET PRCAA2=$PIECE(^(0),U,3)
+5 SET DIE="^PRCA(433,"
SET DA=PRCAEN
+6 ;Bill Number
SET DR=".03////"_PRCABN
+7 ;Calm Code Done
SET DR=DR_";3///0"
+8 ;Transaction Type
SET DR=DR_";12///"_$ORDER(^PRCA(430.3,"AC",57,0))
+9 ;Transaction Amount
SET DR=DR_";15///0"
+10 ;Processed by user
SET DR=DR_";42///"_DUZ
+11 ;Transaction date
SET DR=DR_";11///"_DT
+12 ;Transaction status (complete)
SET DR=DR_";4///2"
+13 SET DR=DR_";5.02///CS INC ADJ TR REV?Y"
DO ^DIE
+14 QUIT
+15 ;
CSITRN ; Cross-Servicing Incr Adj Treasury Rev? No non-financial tx
+1 NEW PRCAEN,PRCAA1,DR,DIE,DA,D0,PRCAD,RCASK,PRCAA2,PRCA,PRCATY,RCUSER,X
+2 DO SETTR^PRCAUTL
DO PATTR^PRCAUTL
if '$DATA(PRCAEN)
QUIT
+3 SET PRCAA1=$SELECT($DATA(^PRCA(433,PRCAEN,4,0)):+$PIECE(^(0),U,4),1:0)
+4 if PRCAA1'>0
QUIT
SET PRCAA2=$PIECE(^(0),U,3)
+5 SET DIE="^PRCA(433,"
SET DA=PRCAEN
+6 ;Bill Number
SET DR=".03////"_PRCABN
+7 ;Calm Code Done
SET DR=DR_";3///0"
+8 ;Transaction Type
SET DR=DR_";12///"_$ORDER(^PRCA(430.3,"AC",58,0))
+9 ;Transaction Amount
SET DR=DR_";15///0"
+10 ;Processed by user
SET DR=DR_";42///"_DUZ
+11 ;Transaction date
SET DR=DR_";11///"_DT
+12 ;Transaction status (complete)
SET DR=DR_";4///2"
+13 SET DR=DR_";5.02///CS INC ADJ TR REV?N"
DO ^DIE
+14 QUIT
+15 ;
CSPRTR ; Cross-Servicing PENDING RECONCILIATION non-financial tx
+1 ; Called by R1^RCTCSPRS
+2 NEW PRCAEN,PRCAA1,DR,DIE,DA,D0,PRCAD,RCASK,PRCAA2,PRCA,PRCATY,RCUSER,DUZ
+3 ; DUZ is reserved, but in this case DUZ may be undefined due to a server background job, but we don't want to overwrite DUZ if it exists
+4 ; Server has no DUZ, use Postmaster
SET PRCABN=BILL
SET DUZ=.5
SET DUZ(0)="@"
SET DUZ(2)=1
+5 DO SETTR^PRCAUTL
DO PATTR^PRCAUTL
if '$DATA(PRCAEN)
QUIT
+6 SET PRCAA1=$SELECT($DATA(^PRCA(433,PRCAEN,4,0)):+$PIECE(^(0),U,4),1:0)
+7 if PRCAA1'>0
QUIT
SET PRCAA2=$PIECE(^(0),U,3)
+8 SET DIE="^PRCA(433,"
SET DA=PRCAEN
+9 ;Bill Number
SET DR=".03////"_PRCABN
+10 ;Calm Code Done
SET DR=DR_";3///0"
+11 ;Transaction Type
SET DR=DR_";12///"_$ORDER(^PRCA(430.3,"AC",61,0))
+12 ;Transaction Amount
SET DR=DR_";15///0"
+13 ;Processed by user
SET DR=DR_";42///"_DUZ
+14 ;Transaction date
SET DR=DR_";11///"_DT
+15 ;Transaction status (complete)
SET DR=DR_";4///2"
+16 SET DR=DR_";5.02///CS PEND RECON"
DO ^DIE
+17 QUIT
+18 ;
CSRCLPL ; CS RECALL placed non-financial tx
+1 NEW PRCAEN,PRCAA1,DR,DIE,DA,D0,PRCAD,RCASK,PRCAA2,PRCA,PRCATY,RCUSER
+2 SET PRCABN=BILL
+3 DO SETTR^PRCAUTL
DO PATTR^PRCAUTL
if '$DATA(PRCAEN)
QUIT
+4 SET PRCAA1=$SELECT($DATA(^PRCA(433,PRCAEN,4,0)):+$PIECE(^(0),U,4),1:0)
+5 if PRCAA1'>0
QUIT
SET PRCAA2=$PIECE(^(0),U,3)
+6 SET DIE="^PRCA(433,"
SET DA=PRCAEN
+7 ;Bill Number
SET DR=".03////"_PRCABN
+8 ;Calm Code Done
SET DR=DR_";3///0"
+9 ;Transaction Type
SET DR=DR_";12///"_$ORDER(^PRCA(430.3,"AC",62,0))
+10 ;Transaction Amount
SET DR=DR_";15///0"
+11 ;Processed by user
SET DR=DR_";42///"_DUZ
+12 ;Transaction date
SET DR=DR_";11///"_DT
+13 ;Transaction status (complete)
SET DR=DR_";4///2"
+14 SET DR=DR_";5.02///CS RECALL PLACED"
DO ^DIE
+15 QUIT
CSAUTORC ; Recall from Cross-Servicing non-financial tx ;PRCA*4.5*369
+1 NEW PRCAEN,PRCAA1,DR,DIE,DA,D0,PRCAD,RCASK,PRCAA2,PRCA,PRCATY,RCUSER,DUZ
+2 ;DUZ is reserved, but in this case DUZ may be undefined due to batch background job
+3 ; Server has no DUZ, use Postmaster
SET PRCABN=BILL
SET DUZ=.5
SET DUZ(0)="@"
SET DUZ(2)=1
+4 DO SETTR^PRCAUTL
DO PATTR^PRCAUTL
if '$DATA(PRCAEN)
QUIT
+5 SET PRCAA1=$SELECT($DATA(^PRCA(433,PRCAEN,4,0)):+$PIECE(^(0),U,4),1:0)
+6 if PRCAA1'>0
QUIT
SET PRCAA2=$PIECE(^(0),U,3)
+7 SET DIE="^PRCA(433,"
SET DA=PRCAEN
+8 ;Bill Number
SET DR=".03////"_PRCABN
+9 ;Calm Code Done
SET DR=DR_";3///0"
+10 ;Transaction Type
SET DR=DR_";12///"_$ORDER(^PRCA(430.3,"AC",66,0))
+11 ;Transaction Amount
SET DR=DR_";15///0"
+12 ;Processed by user
SET DR=DR_";42///"_DUZ
+13 ;Transaction date
SET DR=DR_";11///"_DT
+14 ;Transaction status (complete)
SET DR=DR_";4///2"
+15 SET DR=DR_";5.02///CS AUTO RECALL BILL <$25"
DO ^DIE
+16 QUIT
