VistA-WorldVistAEHR/r/ACCOUNTS_RECEIVABLE-PRCA-PR.../RCXVDC.m

52 lines
1.7 KiB
Mathematica

RCXVDC ;DAOU/ALA-AR Data Extraction Data Creation ;02-JUL-03
;;4.5;Accounts Receivable;**201,228**;Mar 20, 1995
;
Q
EN ; Entry Point
NEW RCXVD0,RCXVEVDT,RCXVBCN
NEW RCXVI,RCXVCP,RCXVPC,RCXVPFDT,RCXVPTDT
NEW RCXVBLNA,RCXVBLNB,RCXVICN
I DFN="" S DFN=$P($G(^PRCA(430,RCXVBLN,0)),U,7) ;
K ^TMP($J)
D D430^RCXVDC1
I DFN'="" D D2^RCXVDC2
D D399^RCXVDC3
D D399PC^RCXVDC4
D D350^RCXVDC5
D D3625^RCXVDC7
I RCXVRT="D"!(RCXVRT="C")!(RCXVRT="E") D D433^RCXVDC6
I RCXVRT="H" D D433B^RCXVDC6
;
FILE ;
W "REC:"_RCXVBLNA,!
W "430:"_$G(^TMP($J,RCXVBLN,"1-430A"))_RCXVU
W $G(^TMP($J,RCXVBLN,"1-430B"))_RCXVU
W $G(^TMP($J,RCXVBLN,"1-430C"))
W !
I DFN'="" W "2:"_$G(^TMP($J,RCXVBLN,"2-2A"))_RCXVU_$G(^TMP($J,RCXVBLN,"2-2B")),!
I $G(^TMP($J,RCXVBLN,"3-399A"))'="" W "399:"_^TMP($J,RCXVBLN,"3-399A")_RCXVU_^TMP($J,RCXVBLN,"3-399B")_RCXVU_^TMP($J,RCXVBLN,"3-399C")_RCXVU_^TMP($J,RCXVBLN,"3-399D"),!
S RCXVPC=0
F S RCXVPC=$O(^TMP($J,RCXVBLN,"4-399A",RCXVPC)) Q:'RCXVPC D
. W "399.0304:"
. W $G(^TMP($J,RCXVBLN,"4-399A",RCXVPC))
. W RCXVU
. F RCXVCP=1:1 Q:('$D(^TMP($J,RCXVBLN,"4-399A",RCXVPC,RCXVCP))) D
. . I RCXVCP>1 W "~"
. . W $G(^TMP($J,RCXVBLN,"4-399A",RCXVPC,RCXVCP))
. . Q
. W !
. I $D(^TMP($J,RCXVBLN,"4-399B",RCXVPC)) W "399.042:"_$G(^TMP($J,RCXVBLN,"4-399B",RCXVPC)),!
. Q
S RCXVI=""
F S RCXVI=$O(^TMP($J,RCXVBLN,"5-350A",RCXVI)) Q:RCXVI="" D
. W "350:"_^TMP($J,RCXVBLN,"5-350A",RCXVI),!
S RCXVI=""
F S RCXVI=$O(^TMP($J,RCXVBLN,"7-362.5A",RCXVI)) Q:RCXVI="" D
. W "362.5:"_^TMP($J,RCXVBLN,"7-362.5A",RCXVI),!
; LOOP THRU ^TMP($J,RCXVBLN,"6-433A",RCXVI)
S RCXVI=""
F S RCXVI=$O(^TMP($J,RCXVBLN,"6-433A",RCXVI)) Q:RCXVI="" D
. W "433:"_$G(^TMP($J,RCXVBLN,"6-433A",RCXVI)),!
. Q
Q