source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCXVDC6.m@ 770

Last change on this file since 770 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.1 KB
Line 
1RCXVDC6 ;DAOU/ALA-AR Data Extraction Data Creation ;02-JUL-03
2 ;;4.5;Accounts Receivable;**201,227,228**;Mar 20, 1995
3 ;
4 ; Accounts Recv. Trans. File (# 433)
5 Q
6D433 ;
7 K ^TMP($J,RCXVBLN,"6-433A")
8 N X,Y
9 ; LOOP THRU(^PRCA(433,"C",RCXVBLN)
10 ;
11 ; If the current fiscal year flag is set, must loop for
12 ; all the transactions since the beginning of the fiscal year
13 I $G(RCXVCFLG)=1 S RCXVBDT=RCXVFFD
14 NEW RCXVD,RCXVDA,RCXVDT,RCXVI,RCXVP1,RCXVP2,RCXVD0B,RCX
15 S RCXVD0B=""
16 F RCXVI=1:1 S RCXVD0B=$O(^PRCA(433,"C",RCXVBLN,RCXVD0B)) Q:RCXVD0B="" D D433A
17 Q
18D433A ;
19 S RCXVD=$G(^PRCA(433,RCXVD0B,1))
20 S RCXVP1=$P($G(^PRCA(433,RCXVD0B,0)),U,2),RCXVP2=""
21 I RCXVP1'="" S RCXVP2=$P($G(^PRCA(430,RCXVP1,0)),U,1)
22 S RCXVDA=RCXVP2 ; BILL NUMBER (P)
23 S RCXVDA=RCXVDA_RCXVU_$P($G(^PRCA(433,RCXVD0B,0)),U,1) ; TRANS. #
24 S RCXVDT=$P(RCXVD,U,9)
25 I RCXVDT<RCXVBDT Q ;QUIT IF DATE ENTERED IS OLDER THAN BATCH DATE
26 S RCXVDT=$P(RCXVD,U)
27 S RCXVDA=RCXVDA_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ; TRANS. DT
28 S RCXVP1=$P(RCXVD,U,2),RCXVP2=""
29 I RCXVP1'="",+$P($G(^PRCA(430.3,RCXVP1,0)),U,6)=0 Q
30 I RCXVP1'="" S RCXVP2=$P($G(^PRCA(430.3,RCXVP1,0)),U,1)
31 S RCXVDA=RCXVDA_RCXVU_RCXVP2 ; TRANS TYPE (P)
32 S RCXVDT=$P(RCXVD,U,9)
33 S RCXVDA=RCXVDA_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ; DT ENTRD
34 S RCXVDA=RCXVDA_RCXVU_$P(RCXVD,U,5) ; TRANS AMT
35 S RCXVDA=RCXVDA_RCXVU_$$GET1^DIQ(433,RCXVD0B_",",88,"E") ; CONT. ADJ.
36 S RCXVDA=RCXVDA_RCXVU_$P(RCXVD,U,3) ;RECEIPT NUMBER
37 S RCXVDT=$P(RCXVD,U,1)
38 S RCXVDA=RCXVDA_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ; DT OF PAYMENT
39 S RCX=0,RCXVDT=""
40 F S RCX=$O(^PRCA(433,RCXVD0B,7,RCX)) Q:'RCX S X=$G(^(RCX,0)) Q:RCXVDT D
41 . Q:X'["Check Date: "
42 . S X=$E(X,13,20) D ^%DT
43 . I Y S RCXVDT=Y
44 . Q
45 S RCXVDA=RCXVDA_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ;CHECK DATE
46 S ^TMP($J,RCXVBLN,"6-433A",RCXVI)=RCXVDA
47 Q
48 ;
49D433B ;
50 NEW RCXVDA,RCXVD0B,RCXVI,RQFL
51 S RCXVD0B="",RQFL=0
52 F RCXVI=1:1 S RCXVD0B=$O(^PRCA(433,"C",RCXVBLN,RCXVD0B)) Q:RCXVD0B="" D Q:RQFL
53 . S RCXVDA=$$GET1^DIQ(433,RCXVD0B_",",88,"E") ; Contractual Adj
54 . I RCXVDA'="" S $P(^TMP($J,RCXVBLN,"6-433A",1),U,7)=RCXVDA,RQFL=1
55 Q
Note: See TracBrowser for help on using the repository browser.