| 1 | RCXVDC6 ;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
|
|---|
| 6 | D433 ;
|
|---|
| 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
|
|---|
| 18 | D433A ;
|
|---|
| 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 | ;
|
|---|
| 49 | D433B ;
|
|---|
| 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
|
|---|
