Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCXVDC6

RCXVDC6.m

Go to the documentation of this file.
  1. RCXVDC6 ;DAOU/ALA-AR Data Extraction Data Creation ;02-JUL-03
  1. ;;4.5;Accounts Receivable;**201,227,228**;Mar 20, 1995
  1. ;
  1. ; Accounts Recv. Trans. File (# 433)
  1. Q
  1. D433 ;
  1. K ^TMP($J,RCXVBLN,"6-433A")
  1. N X,Y
  1. ; LOOP THRU(^PRCA(433,"C",RCXVBLN)
  1. ;
  1. ; If the current fiscal year flag is set, must loop for
  1. ; all the transactions since the beginning of the fiscal year
  1. I $G(RCXVCFLG)=1 S RCXVBDT=RCXVFFD
  1. NEW RCXVD,RCXVDA,RCXVDT,RCXVI,RCXVP1,RCXVP2,RCXVD0B,RCX
  1. S RCXVD0B=""
  1. F RCXVI=1:1 S RCXVD0B=$O(^PRCA(433,"C",RCXVBLN,RCXVD0B)) Q:RCXVD0B="" D D433A
  1. Q
  1. D433A ;
  1. S RCXVD=$G(^PRCA(433,RCXVD0B,1))
  1. S RCXVP1=$P($G(^PRCA(433,RCXVD0B,0)),U,2),RCXVP2=""
  1. I RCXVP1'="" S RCXVP2=$P($G(^PRCA(430,RCXVP1,0)),U,1)
  1. S RCXVDA=RCXVP2 ; BILL NUMBER (P)
  1. S RCXVDA=RCXVDA_RCXVU_$P($G(^PRCA(433,RCXVD0B,0)),U,1) ; TRANS. #
  1. S RCXVDT=$P(RCXVD,U,9)
  1. I RCXVDT<RCXVBDT Q ;QUIT IF DATE ENTERED IS OLDER THAN BATCH DATE
  1. S RCXVDT=$P(RCXVD,U)
  1. S RCXVDA=RCXVDA_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ; TRANS. DT
  1. S RCXVP1=$P(RCXVD,U,2),RCXVP2=""
  1. I RCXVP1'="",+$P($G(^PRCA(430.3,RCXVP1,0)),U,6)=0 Q
  1. I RCXVP1'="" S RCXVP2=$P($G(^PRCA(430.3,RCXVP1,0)),U,1)
  1. S RCXVDA=RCXVDA_RCXVU_RCXVP2 ; TRANS TYPE (P)
  1. S RCXVDT=$P(RCXVD,U,9)
  1. S RCXVDA=RCXVDA_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ; DT ENTRD
  1. S RCXVDA=RCXVDA_RCXVU_$P(RCXVD,U,5) ; TRANS AMT
  1. S RCXVDA=RCXVDA_RCXVU_$$GET1^DIQ(433,RCXVD0B_",",88,"E") ; CONT. ADJ.
  1. S RCXVDA=RCXVDA_RCXVU_$P(RCXVD,U,3) ;RECEIPT NUMBER
  1. S RCXVDT=$P(RCXVD,U,1)
  1. S RCXVDA=RCXVDA_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ; DT OF PAYMENT
  1. S RCX=0,RCXVDT=""
  1. F S RCX=$O(^PRCA(433,RCXVD0B,7,RCX)) Q:'RCX S X=$G(^(RCX,0)) Q:RCXVDT D
  1. . Q:X'["Check Date: "
  1. . S X=$E(X,13,20) D ^%DT
  1. . I Y S RCXVDT=Y
  1. . Q
  1. S RCXVDA=RCXVDA_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ;CHECK DATE
  1. S ^TMP($J,RCXVBLN,"6-433A",RCXVI)=RCXVDA
  1. Q
  1. ;
  1. D433B ;
  1. NEW RCXVDA,RCXVD0B,RCXVI,RQFL
  1. S RCXVD0B="",RQFL=0
  1. F RCXVI=1:1 S RCXVD0B=$O(^PRCA(433,"C",RCXVBLN,RCXVD0B)) Q:RCXVD0B="" D Q:RQFL
  1. . S RCXVDA=$$GET1^DIQ(433,RCXVD0B_",",88,"E") ; Contractual Adj
  1. . I RCXVDA'="" S $P(^TMP($J,RCXVBLN,"6-433A",1),U,7)=RCXVDA,RQFL=1
  1. Q