source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCXFMSTX.m@ 1710

Last change on this file since 1710 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.6 KB
Line 
1RCXFMSTX ;WISC/RFJ-fms transfer (tr) code sheet generator ;1 Oct 97
2 ;;4.5;Accounts Receivable;**170,178,191,184**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7STARTTR(RCDATEND) ; top entry point to generate a tr code sheet
8 ; transferring dollars from mccf to hsif
9 ;
10 ; rcdatend is the ending date of the period.
11 ; This date is the 3rd work day from the end of the month.
12 ; The utility $$LDATE^RCRJR is used to figure it out. It will
13 ; change from month to month and figures in holidays also.
14 ; For example, if running the ARDC for the month of June 2003
15 ; the EOAM will calculate out to be June 25, 2003.
16 ; This is called by the background monthly data collector
17 ;
18 ;
19 N GECSDATA,RCTRANID,RESULT
20 ;
21 ; build the data for the TR document. this call returns the rctrans
22 ; array in the format rctrans(fromfund,fromrsc) = tofund ^ torsc ^
23 ; amount
24 ; example:
25 ; rctrans(5287,"8bzz")="5358.1^8gzz^123.45"
26 ; will transfer 123.45 from 5287 to 5358.1
27 D GETPAY^RCBMILLT(RCDATEND)
28 ;
29 ; no code sheets to send
30 I $O(RCTRANS(""))="" Q
31 ;
32 ; lookup fms document number to see if the monthly tr has been sent
33 ; example rcdatend=3010531, lookup on 3010500
34 D KEYLOOK^GECSSGET("TR-"_$E(RCDATEND,1,5)_"00",1)
35 ;
36 ; get the transacion id for the fms document
37 ; if it is not sent, get the next number available
38 I $G(GECSDATA) S RCTRANID=$E($P(GECSDATA("2100.1",GECSDATA,".01","E"),"-",2),1,11)
39 I $G(RCTRANID)="" S RCTRANID=$$ENUM^RCMSNUM
40 I RCTRANID<0 Q ;unable to retrieve the next number
41 ; remove dash (example 460-K1A05HY)
42 S RCTRANID=$TR(RCTRANID,"-")
43 ;
44 ; build the tr document
45 S RESULT=$$BUILDTR(RCDATEND,.RCTRANS,+$G(GECSDATA),RCTRANID)
46 ; error in building code sheet
47 I 'RESULT Q
48 ;
49 ; set the 433 fields showing the dollars were transferred
50 D SETPAY^RCBMILLT(RCDATEND)
51 ;
52 ; add/update entry in file 347 for reports
53 N %DT,%X,D,D0,DA347,DI,DQ,DIC,ERROR
54 S DA347=$O(^RC(347,"C",$P(RESULT,"^",2),0))
55 ; if not in the file, addit fmsdocid sv id
56 I 'DA347 D OPEN^RCFMDRV1($P(RESULT,"^",2),4,"TR-"_$E(RCDATEND,1,5)_"00",.DA347,.ERROR)
57 I DA347 D SSTAT^RCFMFN02($P(RESULT,"^",2),1)
58 Q
59 ;
60 ;
61BUILDTR(RCDATEND,RCTRANS,RCGECSDA,RCTRANID) ; generate a tr code sheet for
62 ; transferring dollars from mccf to hsif
63 ;
64 ; rcdatend is the last day of the month for the data
65 ;
66 ; rctrans(fund,rsc) = data array passed
67 ; fund=fund to transfer from
68 ; rsc = rsc to transfer from
69 ; data = fund to transfer to (piece 1)
70 ; rsc to transfer to (piece 2)
71 ; dollars to transfer (piece 3)
72 ;
73 ; rcgecsda is the ien for the gcs stack file 2100.1 for rebuilds
74 ;
75 ; rctranid is the document identifier
76 ;
77 N COUNT,DATA,DESCRIP,FISCALYR,FUND,GECSFMS,LINE,REVSRCE,TR2,X,Y
78 ;
79 S FISCALYR=$$FY^RCFN01(RCDATEND)
80 ;
81 ; build detail line
82 S COUNT=0
83 S FUND="" F S FUND=$O(RCTRANS(FUND)) Q:FUND="" D
84 . S REVSRCE="" F S REVSRCE=$O(RCTRANS(FUND,REVSRCE)) Q:'REVSRCE D
85 . . S DATA=RCTRANS(FUND,REVSRCE)
86 . . ; if no value, quit
87 . . I '$P(DATA,"^",3) Q
88 . . ;
89 . . ; create line to transfer from (decrease)
90 . . S COUNT=COUNT+1
91 . . S LINE(COUNT)="LIN^~CRA^"_$S($L(COUNT)=1:"00",$L(COUNT)=2:"0",1:"")_COUNT
92 . . S $P(LINE(COUNT),"^",4)=FISCALYR
93 . . S $P(LINE(COUNT),U,4)=$S($E(FUND,1,4)=5287:"05",1:FISCALYR)
94 . . S $P(LINE(COUNT),"^",6)=FUND
95 . . S $P(LINE(COUNT),"^",7)=$E(RCTRANID,1,3) ; station #
96 . . S $P(LINE(COUNT),"^",10)=REVSRCE
97 . . ;
98 . . ; vendor id
99 . . S $P(LINE(COUNT),"^",18)="MCCFVALUE"
100 . . I FUND=5358.1 S $P(LINE(COUNT),"^",18)="HSIFVALUE"
101 . . ;
102 . . S $P(LINE(COUNT),"^",20)=$J($P(DATA,"^",3),0,2)
103 . . S $P(LINE(COUNT),"^",21)="D"
104 . . S $P(LINE(COUNT),"^",23)=33
105 . . S $P(LINE(COUNT),"^",24)="~"
106 . . ;
107 . . ; create line to transfer to (increase)
108 . . S COUNT=COUNT+1
109 . . S LINE(COUNT)="LIN^~CRA^"_$S($L(COUNT)=1:"00",$L(COUNT)=2:"0",1:"")_COUNT
110 . . S $P(LINE(COUNT),"^",4)=FISCALYR
111 . . S $P(LINE(COUNT),U,4)=$S($E(FUND,1,4)=5287:"05",1:FISCALYR)
112 . . S $P(LINE(COUNT),"^",6)=$P(DATA,"^")
113 . . S $P(LINE(COUNT),"^",7)=$E(RCTRANID,1,3) ; station #
114 . . S $P(LINE(COUNT),"^",10)=$P(DATA,"^",2)
115 . . ;
116 . . ; vendor id
117 . . S $P(LINE(COUNT),"^",18)="MCCFVALUE"
118 . . I $P(DATA,"^")=5358.1 S $P(LINE(COUNT),"^",18)="HSIFVALUE"
119 . . ;
120 . . S $P(LINE(COUNT),"^",20)=$J($P(DATA,"^",3),0,2)
121 . . S $P(LINE(COUNT),"^",21)="I"
122 . . S $P(LINE(COUNT),"^",23)=33
123 . . S $P(LINE(COUNT),"^",24)="~"
124 ;
125 ; build tr2
126 S TR2="CR2^"_$E(RCDATEND,2,3)_"^"_$E(RCDATEND,4,5)_"^"_$E(RCDATEND,6,7)_"^^^^^^E^^^"
127 ; deposit number which is equal to the gcs id
128 ; $j(0,0,2) is the document total which is zero
129 S TR2=TR2_$P(RCTRANID,"^")_"^^"_$J(0,0,2)_"^^"
130 ; deposit/transfer date which is end date of prior month
131 S TR2=TR2_$E(RCDATEND,2,3)_"^"_$E(RCDATEND,4,5)_"^"_$E(RCDATEND,6,7)_"^~"
132 ;
133 ; put together document in gcs
134 N %DT,D,D0,DA,DI,DIC,DIE,DIQ2,DQ,DR
135 S Y=$E(RCDATEND,1,5)_"00" D DD^%DT
136 S DESCRIP="Monthly Transfer MCCF to HSIF for "_Y
137 I 'RCGECSDA D CONTROL^GECSUFMS("A",$E(RCTRANID,1,3),RCTRANID,"TR",10,0,"",DESCRIP)
138 I RCGECSDA D REBUILD^GECSUFM1(RCGECSDA,"A",10,"N","Rebuild "_DESCRIP) S GECSFMS("DA")=RCGECSDA
139 ;
140 ; store document in gcs
141 D SETCS^GECSSTAA(GECSFMS("DA"),TR2)
142 F COUNT=1:1 Q:'$D(LINE(COUNT)) D SETCS^GECSSTAA(GECSFMS("DA"),LINE(COUNT))
143 D SETCODE^GECSSDCT(GECSFMS("DA"),"D RETN^RCFMFN02")
144 D SETSTAT^GECSSTAA(GECSFMS("DA"),"Q")
145 ; set the key for lookup
146 D SETKEY^GECSSTAA(GECSFMS("DA"),"TR-"_$E(RCDATEND,1,5)_"00")
147 ;
148 ; return 1 for success ^ fms document id
149 Q 1_"^TR-"_$P(GECSFMS("CTL"),"^",9)
Note: See TracBrowser for help on using the repository browser.