| 1 | RCXFMSUV ;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 | ;
|
|---|
| 7 | VENDORID(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 | ;
|
|---|
| 81 | LINKASK ;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
|
|---|
| 84 | LINK ;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 | ;
|
|---|
| 89 | STOREL(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 | ;
|
|---|
| 97 | STORE(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
|
|---|
