source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCXFMSUV.m@ 1006

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

initial load of WorldVistAEHR

File size: 4.0 KB
Line 
1RCXFMSUV ;WISC/RFJ-fms vendor id ;9/17/98 11:42 AM
2 ;;4.5;Accounts Receivable;**90,119,98,165,192,220**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7VENDORID(BILLDA) ; return the vendorid for a bill (used on a BD document)
8 ; returns null if vendor id is not required
9 ; returns UNKNOWN if vendor id is required but could not be determined
10 N ACCRUAL,CATEGORY,DEBTOR,RSC,VENDORID,VENDOR,DIR,VENFLAG
11 ;
12 ; accrued bills get sent to mccf 5287 fund, no vendor id
13 S ACCRUAL=$$ACCK^PRCAACC(BILLDA)
14 I ACCRUAL Q ""
15 ;
16 ; if not a category, cannot determine vendor id
17 S CATEGORY=$P($G(^PRCA(430,BILLDA,0)),"^",2)
18 I 'CATEGORY Q ""
19 ;
20 ; if vendor(17) or military(12) or federal agencies refund(13)
21 ; or federal agencies-reimb(14) or interagency(20)
22 ; sharing agreements(19),nursing Home Proceeds (40)
23 ; parking fees (41), cwt proceeds (42), comp & pen proceeds (43)
24 ; Enhanced Use Lease Proceeds (44), then get vendor id
25 S VENFLAG=$S(CATEGORY=17:2,CATEGORY=12:1,CATEGORY=13:1,CATEGORY=14:1,CATEGORY=20:1,CATEGORY=19:1,CATEGORY=40:2,CATEGORY=41:2,CATEGORY=42:2,CATEGORY=43:2,CATEGORY=44:2,1:0)
26 I VENFLAG D Q VENDORID
27 .S DEBTOR=+$P($G(^PRCA(430,BILLDA,0)),"^",9),VENDOR=$P($G(^RCD(340,DEBTOR,0)),U)
28 .I VENDOR="" S VENDORID="UNKNOWN" Q
29 .I VENFLAG=2,VENDOR["VA(" S VENDORID="PERSONOTH" D STORE(BILLDA,"PERSONOTH") Q
30 .I VENDOR["PRC(" D Q
31 ..S VENDORID=$$VEN^PRCHUTL(+VENDOR)
32 ..I VENDORID'="" D STORE(BILLDA,VENDORID) Q
33 ..I VENFLAG=2 D Q
34 ...S DIR(0)="Y",DIR("A")="Can this bill be offset by FMS "
35 ...S DIR("B")="YES" D ^DIR
36 ...S VENDORID=$S(Y=0:"PERSONOTH",1:"UNKNOWN")
37 ...D:VENDORID="PERSONOTH" STORE(BILLDA,"PERSONOTH")
38 ...Q
39 ..S VENDORID="UNKNOWN"
40 ..Q
41 .S VENDOR=$P(^RCD(340,+DEBTOR,0),U,6)
42 .I VENDOR'="" S VENDORID=$$VEN^PRCHUTL(VENDOR) D Q
43 ..I VENDORID="" S VENDORID="UNKNOWN" Q
44 ..D STORE(BILLDA,VENDORID)
45 ..Q
46 .I '$D(^XUSEC("PRCA VENDOR",DUZ)) S VENDORID="LINK" Q
47 .W !!,"DEBTOR MUST BE LINKED TO VENDOR FILE"
48 .S VENDOR=$$VENSEL^PRCHUTL()
49 .I VENDOR<0 S VENDORID="LINK" Q
50 .S VENDORID=$$VEN^PRCHUTL(VENDOR)
51 .I VENDORID="" S VENDORID="UNKNOWN" Q
52 .D STORE(BILLDA,VENDORID),STOREL(+DEBTOR,VENDOR)
53 .Q
54 ;
55 ; for ineligible send INELIG
56 I CATEGORY=1 D STORE(BILLDA,"INELIG") Q "INELIG"
57 ; for ex-employee send XEMPL
58 I CATEGORY=15 D STORE(BILLDA,"XEMPL") Q "XEMPL"
59 ; for current employee send CUREMPL
60 I CATEGORY=16 D STORE(BILLDA,"CUREMPL") Q "CUREMPL"
61 ;
62 ; champva subsitence(27), champva third party(28)
63 I CATEGORY=27 D STORE(BILLDA,"CHMPVA1ST") Q "CHMPVA1ST"
64 I CATEGORY=28 D STORE(BILLDA,"CHMPVA3RD") Q "CHMPVA3RD"
65 ; champva(29) does not get sent to FMS, code commented out
66 ;I CATEGORY=29 Q ""
67 ;
68 ; tricare(30), tricare patient(31), tricare third party(32)
69 ; test for tricare by looking at the revenue source code
70 S RSC=$P($G(^PRCA(430,BILLDA,11)),"^",6)
71 I RSC>8027,RSC<8031 D D STORE(BILLDA,VENDORID) Q VENDORID
72 .S VENDORID=$S(RSC=8028:"TRIINPAT",RSC=8029:"TRIOUTPAT",1:"TRIOTH")
73 .Q
74 I CATEGORY>29,CATEGORY<33 D D STORE(BILLDA,VENDORID) Q VENDORID
75 .S VENDORID=$S(CATEGORY=30:"TRICAROTH",CATEGORY=31:"TRICAROPT",1:"TRICARINP")
76 .Q
77 ; vendor id not known, process should never reach this line of code
78 Q "UNKNOWN"
79 ;
80 ;
81LINKASK ;ENTRY POINT FOR MENU OPTION TO STORE LINK
82 N DIC,Y
83 S DIC=340,DIC(0)="AEQM",DIC("A")="Enter Debtor to be linked to Vendor File: ",DIC("S")="I $P(^RCD(340,+Y,0),U)'[""PRC(""" D ^DIC Q:Y<0 S DEBTOR=+Y
84LINK ;LINKS DEBTOR TO VENDOR FILE
85 S VENDOR=$$VENSEL^PRCHUTL() I VENDOR<0 S VENDOR="LINK" Q
86 D STOREL(DEBTOR,VENDOR) Q
87 ;
88 ;
89STOREL(DA,VENDOR) ; store the link from the debtor file to the vendor file
90 N D,D0,DI,DIC,DIE,DQ,DR,X,Y
91 S DR=".06////"_VENDOR_";"
92 S (DIC,DIE)="^RCD(340,"
93 D ^DIE
94 Q
95 ;
96 ;
97STORE(DA,VENDORID) ;STORES THE VENDOR ID WITH THE BILL
98 I $G(^PRCA(430,DA,0))="" Q
99 N D0,DI,DIC,DIE,DQ,DR,X,Y,D
100 S DR="265////"_VENDORID_";"
101 S (DIC,DIE)="^PRCA(430,"
102 D ^DIE
103 Q
Note: See TracBrowser for help on using the repository browser.