source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCXFMSWR.m@ 1589

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

initial load of FOIAVistA 6/30/08 version
File size: 4.5 KB
Line 
1RCXFMSWR ;WISC/RFJ-fms writeoff (wr) code sheet generator ;1 Nov 97
2 ;;4.5;Accounts Receivable;**96,135,98,156,170,191,220,184**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7STARTWR(RCDATEND) ; top entry point to generate a wr code sheet
8 ;
9 ; rcdatend is the ending date of the period.
10 ; This date is the 3rd work day from the end of the month.
11 ; The utility $$LDATE^RCRJR is used to figure it out. It will
12 ; change from month to month and figures in holidays also.
13 ; For example, if running the ARDC for the month of June 2003
14 ; the EOAM will calculate out to be June 25, 2003.
15 ; This is called by the background monthly data collector
16 ;
17 ; data stored in tmp($j,rcrjrcolwr,type,revsourcecode)
18 ; this is called by the background monthly data collector
19 ;
20 N GECSDATA,RCTRANID,RESULT
21 ; lookup fms document number to see if the monthly sv has been sent
22 ; example rcdatend=3010531, lookup on 3010500
23 D KEYLOOK^GECSSGET("WR-"_$E(RCDATEND,1,5)_"00",1)
24 ;
25 ; get the transacion id for the fms document
26 ; if it is not sent, get the next number available
27 I $G(GECSDATA) S RCTRANID=$E($P(GECSDATA("2100.1",GECSDATA,".01","E"),"-",2),1,11)
28 I $G(RCTRANID)="" S RCTRANID=$$ENUM^RCMSNUM
29 I RCTRANID<0 Q ;unable to retrieve the next number
30 ; remove dash (example 460-K1A05HY)
31 S RCTRANID=$TR(RCTRANID,"-")
32 ;
33 ; build and send the sv document to fms
34 S RESULT=$$BUILDWR(RCDATEND,+$G(GECSDATA),RCTRANID)
35 ; error in building code sheet
36 I 'RESULT Q
37 ;
38 ; add/update entry in file 347 for reports
39 N %DT,%X,D,D0,DA347,DI,DQ,DIC,ERROR
40 S DA347=$O(^RC(347,"D","WR-"_$E(RCDATEND,1,5)_"00",0))
41 ; if not in the file, addit fmsdocid wr id
42 I 'DA347 D OPEN^RCFMDRV1($P(RESULT,"^",2),8,"WR-"_$E(RCDATEND,1,5)_"00",.DA347,.ERROR)
43 I DA347 D SSTAT^RCFMFN02($P(RESULT,"^",2),1)
44 Q
45 ;
46 ;
47BUILDWR(RCDATEND,RCGECSDA,RCTRANID) ; generate a wr code sheet for monthly data
48 ; rcgecsda is the ien for the gcs stack file 2100.1 for rebuilds
49 ; data stored in tmp($j,rcrjrcolwr)
50 ;
51 N AMOUNT,COUNT,CR2,DESCRIP,DOCTOTAL,FISCALYR,FMSLINE,FUND,GECSFMS,RSC,TYPE
52 ;
53 S FISCALYR=$$FY^RCFN01(RCDATEND)
54 ;
55 S COUNT=0,DOCTOTAL=0
56 S TYPE="" F S TYPE=$O(^TMP($J,"RCRJRCOLWR",TYPE)) Q:TYPE="" D
57 . S FUND="" F S FUND=$O(^TMP($J,"RCRJRCOLWR",TYPE,FUND)) Q:FUND="" D
58 . . S RSC="" F S RSC=$O(^TMP($J,"RCRJRCOLWR",TYPE,FUND,RSC)) Q:RSC="" D
59 . . . S AMOUNT=^TMP($J,"RCRJRCOLWR",TYPE,FUND,RSC),DOCTOTAL=DOCTOTAL+AMOUNT
60 . . . I AMOUNT=0 Q
61 . . . S COUNT=COUNT+1
62 . . . S FMSLINE(COUNT)="LIN^~CRA^"_$S($L(COUNT)=1:"00",$L(COUNT)=2:"0",1:"")_COUNT
63 . . . ;S $P(FMSLINE(COUNT),"^",4)=$S(FUND=4032:"03",1:FISCALYR) ;begin fy
64 . . . S $P(FMSLINE(COUNT),"^",4)=FISCALYR ;begin fy
65 . . . S $P(FMSLINE(COUNT),"^",4)=$S($E(FUND,1,4)=5287:"05",1:FISCALYR) ;begin fy
66 . . . S $P(FMSLINE(COUNT),"^",6)=FUND
67 . . . S $P(FMSLINE(COUNT),"^",7)=$E(RCTRANID,1,3) ;site number
68 . . . S $P(FMSLINE(COUNT),"^",10)=RSC
69 . . . ;
70 . . . ; vendor id
71 . . . S $P(FMSLINE(COUNT),"^",18)="MCCFVALUE"
72 . . . I FUND=4032!(FUND=528709) S $P(FMSLINE(COUNT),"^",18)="EXCFVALUE"
73 . . . ; for transaction type P4, send vendorid of PERSONOTH
74 . . . I TYPE="P4" S $P(FMSLINE(COUNT),"^",18)="PERSONOTH"
75 . . . ;
76 . . . S $P(FMSLINE(COUNT),"^",20)=$J(AMOUNT,0,2)
77 . . . S $P(FMSLINE(COUNT),"^",21)="I"
78 . . . S $P(FMSLINE(COUNT),"^",23)=TYPE_"^~"
79 ;
80 ; no code sheets to send
81 I COUNT=0 Q "0^No wr code sheets to send for this month"
82 ;
83 S CR2="CR2^"_$E(RCDATEND,2,3)_"^"_$E(RCDATEND,4,5)_"^"_$E(RCDATEND,6,7)
84 S $P(CR2,"^",10)="E"
85 S $P(CR2,"^",13)=999999999999
86 S $P(CR2,"^",15)=$J(DOCTOTAL,0,2)
87 S $P(CR2,"^",17)=$E(RCDATEND,2,3)
88 S $P(CR2,"^",18)=$E(RCDATEND,4,5)
89 S $P(CR2,"^",19)=$E(RCDATEND,6,7)_"^~"
90 ;
91 ; put together document in gcs
92 N %DT,D0,DA,DI,DIC,DIE,DQ,DR,X,Y
93 S Y=$E(RCDATEND,1,5)_"00" D DD^%DT
94 S DESCRIP="Monthly Write Off for "_Y
95 I 'RCGECSDA D CONTROL^GECSUFMS("A",$E(RCTRANID,1,3),RCTRANID,"WR",10,0,"",DESCRIP)
96 I RCGECSDA D REBUILD^GECSUFM1(RCGECSDA,"A",10,"N","Rebuild "_DESCRIP) S GECSFMS("DA")=RCGECSDA
97 ;
98 ; store document in gcs
99 D SETCS^GECSSTAA(GECSFMS("DA"),CR2)
100 F COUNT=1:1 Q:'$D(FMSLINE(COUNT)) D SETCS^GECSSTAA(GECSFMS("DA"),FMSLINE(COUNT))
101 D SETCODE^GECSSDCT(GECSFMS("DA"),"D RETN^RCFMFN02")
102 D SETSTAT^GECSSTAA(GECSFMS("DA"),"Q")
103 ; set the key for lookup
104 D SETKEY^GECSSTAA(GECSFMS("DA"),"WR-"_$E(RCDATEND,1,5)_"00")
105 ;
106 ; return 1 for success ^ fms document transaction number
107 Q "1^WR-"_$P(GECSFMS("CTL"),"^",9)
Note: See TracBrowser for help on using the repository browser.