1 | RCXVDC ;DAOU/ALA-AR Data Extraction Data Creation ;02-JUL-03
|
---|
2 | ;;4.5;Accounts Receivable;**201,228**;Mar 20, 1995
|
---|
3 | ;
|
---|
4 | Q
|
---|
5 | EN ; Entry Point
|
---|
6 | NEW RCXVD0,RCXVEVDT,RCXVBCN
|
---|
7 | NEW RCXVI,RCXVCP,RCXVPC,RCXVPFDT,RCXVPTDT
|
---|
8 | NEW RCXVBLNA,RCXVBLNB,RCXVICN
|
---|
9 | I DFN="" S DFN=$P($G(^PRCA(430,RCXVBLN,0)),U,7) ;
|
---|
10 | K ^TMP($J)
|
---|
11 | D D430^RCXVDC1
|
---|
12 | I DFN'="" D D2^RCXVDC2
|
---|
13 | D D399^RCXVDC3
|
---|
14 | D D399PC^RCXVDC4
|
---|
15 | D D350^RCXVDC5
|
---|
16 | D D3625^RCXVDC7
|
---|
17 | I RCXVRT="D"!(RCXVRT="C")!(RCXVRT="E") D D433^RCXVDC6
|
---|
18 | I RCXVRT="H" D D433B^RCXVDC6
|
---|
19 | ;
|
---|
20 | FILE ;
|
---|
21 | W "REC:"_RCXVBLNA,!
|
---|
22 | W "430:"_$G(^TMP($J,RCXVBLN,"1-430A"))_RCXVU
|
---|
23 | W $G(^TMP($J,RCXVBLN,"1-430B"))_RCXVU
|
---|
24 | W $G(^TMP($J,RCXVBLN,"1-430C"))
|
---|
25 | W !
|
---|
26 | I DFN'="" W "2:"_$G(^TMP($J,RCXVBLN,"2-2A"))_RCXVU_$G(^TMP($J,RCXVBLN,"2-2B")),!
|
---|
27 | 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"),!
|
---|
28 | S RCXVPC=0
|
---|
29 | F S RCXVPC=$O(^TMP($J,RCXVBLN,"4-399A",RCXVPC)) Q:'RCXVPC D
|
---|
30 | . W "399.0304:"
|
---|
31 | . W $G(^TMP($J,RCXVBLN,"4-399A",RCXVPC))
|
---|
32 | . W RCXVU
|
---|
33 | . F RCXVCP=1:1 Q:('$D(^TMP($J,RCXVBLN,"4-399A",RCXVPC,RCXVCP))) D
|
---|
34 | . . I RCXVCP>1 W "~"
|
---|
35 | . . W $G(^TMP($J,RCXVBLN,"4-399A",RCXVPC,RCXVCP))
|
---|
36 | . . Q
|
---|
37 | . W !
|
---|
38 | . I $D(^TMP($J,RCXVBLN,"4-399B",RCXVPC)) W "399.042:"_$G(^TMP($J,RCXVBLN,"4-399B",RCXVPC)),!
|
---|
39 | . Q
|
---|
40 | S RCXVI=""
|
---|
41 | F S RCXVI=$O(^TMP($J,RCXVBLN,"5-350A",RCXVI)) Q:RCXVI="" D
|
---|
42 | . W "350:"_^TMP($J,RCXVBLN,"5-350A",RCXVI),!
|
---|
43 | S RCXVI=""
|
---|
44 | F S RCXVI=$O(^TMP($J,RCXVBLN,"7-362.5A",RCXVI)) Q:RCXVI="" D
|
---|
45 | . W "362.5:"_^TMP($J,RCXVBLN,"7-362.5A",RCXVI),!
|
---|
46 | ; LOOP THRU ^TMP($J,RCXVBLN,"6-433A",RCXVI)
|
---|
47 | S RCXVI=""
|
---|
48 | F S RCXVI=$O(^TMP($J,RCXVBLN,"6-433A",RCXVI)) Q:RCXVI="" D
|
---|
49 | . W "433:"_$G(^TMP($J,RCXVBLN,"6-433A",RCXVI)),!
|
---|
50 | . Q
|
---|
51 | Q
|
---|