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