source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCXVDC.m

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

initial load of FOIAVistA 6/30/08 version

File size: 1.8 KB
Line 
1RCXVDC ;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
6EN ; 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 ;
21FILE ;
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
Note: See TracBrowser for help on using the repository browser.