RCXVDC8 ;DAOU/ALA-AR Data Extraction Data Creation ;02-JUL-03
;;4.5;Accounts Receivable;**201,228**;Mar 20, 1995
;
; AR Batch Payment File (# 344)
Q
D344 ;
N RCSITE
S RCXVD=$G(^RCY(344,RCXVD0,0)) ;
S RCXVP1=$P(RCXVD,U,6) ; PTR TO DEPOSIT TICKET
I RCXVP1="" Q
S RCXVD1=$G(^RCY(344.1,RCXVP1,0))
;
S RCXVDA=$P(RCXVD,U,1)
S RCXVDA=RCXVDA_RCXVU_$P(RCXVD1,U,1) ; Ticket # (P)
S RCXVDA=RCXVDA_RCXVU_$E($$HLDATE^HLFNC($P(RCXVD,U,8)),1,8) ; Date/Time Proc
S RCXVDA=RCXVDA_RCXVU_$P(RCXVD1,U,4) ; (344.1) Amt Deposit
S RCXVDA=RCXVDA_RCXVU_$$RECTOTAL^RCDPURED(RCXVP1) ; Totl Amt of Receipts (Comp)
S RCXVDA=RCXVDA_RCXVU_$$RECCOUNT^RCDPURED(RCXVP1) ; Totl Receipts (Comp)
S RCSITE=$P($$SITE^VASITE(),U,3)
S RCXVDA=RCXVDA_U_RCSITE
S ^TMP($J,"RCXVDC8",RCXVD0)=RCXVDA
W "REC:"_$P(RCXVDA,RCXVU,1),!
W "344:"_$P(RCXVDA,RCXVU,2,7),!
;
S RCXVI=""
F S RCXVI=$O(^TMP($J,"7-162A",RCXVI)) Q:RCXVI="" D
. W "162:"_$G(^TMP($J,"7-162A",RCXVI))
. W !
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCXVDC8 992 printed Oct 16, 2024@17:50:27 Page 2
RCXVDC8 ;DAOU/ALA-AR Data Extraction Data Creation ;02-JUL-03
+1 ;;4.5;Accounts Receivable;**201,228**;Mar 20, 1995
+2 ;
+3 ; AR Batch Payment File (# 344)
+4 QUIT
D344 ;
+1 NEW RCSITE
+2 ;
SET RCXVD=$GET(^RCY(344,RCXVD0,0))
+3 ; PTR TO DEPOSIT TICKET
SET RCXVP1=$PIECE(RCXVD,U,6)
+4 IF RCXVP1=""
QUIT
+5 SET RCXVD1=$GET(^RCY(344.1,RCXVP1,0))
+6 ;
+7 SET RCXVDA=$PIECE(RCXVD,U,1)
+8 ; Ticket # (P)
SET RCXVDA=RCXVDA_RCXVU_$PIECE(RCXVD1,U,1)
+9 ; Date/Time Proc
SET RCXVDA=RCXVDA_RCXVU_$EXTRACT($$HLDATE^HLFNC($PIECE(RCXVD,U,8)),1,8)
+10 ; (344.1) Amt Deposit
SET RCXVDA=RCXVDA_RCXVU_$PIECE(RCXVD1,U,4)
+11 ; Totl Amt of Receipts (Comp)
SET RCXVDA=RCXVDA_RCXVU_$$RECTOTAL^RCDPURED(RCXVP1)
+12 ; Totl Receipts (Comp)
SET RCXVDA=RCXVDA_RCXVU_$$RECCOUNT^RCDPURED(RCXVP1)
+13 SET RCSITE=$PIECE($$SITE^VASITE(),U,3)
+14 SET RCXVDA=RCXVDA_U_RCSITE
+15 SET ^TMP($JOB,"RCXVDC8",RCXVD0)=RCXVDA
+16 WRITE "REC:"_$PIECE(RCXVDA,RCXVU,1),!
+17 WRITE "344:"_$PIECE(RCXVDA,RCXVU,2,7),!
+18 ;
+19 SET RCXVI=""
+20 FOR
SET RCXVI=$ORDER(^TMP($JOB,"7-162A",RCXVI))
if RCXVI=""
QUIT
Begin DoDot:1
+21 WRITE "162:"_$GET(^TMP($JOB,"7-162A",RCXVI))
+22 WRITE !
End DoDot:1
+23 QUIT
+24 ;
