RCXFMSUV ;WISC/RFJ-fms vendor id ;9/17/98 11:42 AM
;;4.5;Accounts Receivable;**90,119,98,165,192,220,315,338**;Mar 20, 1995;Build 69
;;Per VA Directive 6402, this routine should not be modified.
Q
;
;
VENDORID(BILLDA) ; return the vendorid for a bill (used on a BD document)
; returns null if vendor id is not required
; returns UNKNOWN if vendor id is required but could not be determined
N ACCRUAL,CATEGORY,DEBTOR,RSC,VENDORID,VENDOR,DIR,VENFLAG
;
; accrued bills get sent to mccf 5287 fund, no vendor id
S ACCRUAL=$$ACCK^PRCAACC(BILLDA)
;
; if not a category, cannot determine vendor id
S CATEGORY=$P($G(^PRCA(430,BILLDA,0)),"^",2)
I 'CATEGORY Q ""
I ACCRUAL Q "" ;
;
;
; if vendor(17) or military(12) or federal agencies refund(13)
; or federal agencies-reimb(14) or interagency(20)
; sharing agreements(19),nursing Home Proceeds (40)
; parking fees (41), cwt proceeds (42), comp & pen proceeds (43)
; Enhanced Use Lease Proceeds (44), then get vendor id
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,CATEGORY=47:1,1:0)
I VENFLAG D Q VENDORID
.S DEBTOR=+$P($G(^PRCA(430,BILLDA,0)),"^",9),VENDOR=$P($G(^RCD(340,DEBTOR,0)),U)
.I VENDOR="" S VENDORID="UNKNOWN" Q
.I VENFLAG=2,VENDOR["VA(" S VENDORID="PERSONOTH" D STORE(BILLDA,"PERSONOTH") Q
.I VENDOR["PRC(" D Q
..S VENDORID=$$VEN^PRCHUTL(+VENDOR)
..I VENDORID'="" D STORE(BILLDA,VENDORID) Q
..I VENFLAG=2 D Q
...S DIR(0)="Y",DIR("A")="Can this bill be offset by FMS "
...S DIR("B")="YES" D ^DIR
...S VENDORID=$S(Y=0:"PERSONOTH",1:"UNKNOWN")
...D:VENDORID="PERSONOTH" STORE(BILLDA,"PERSONOTH")
...Q
..S VENDORID="UNKNOWN"
..Q
.S VENDOR=$P(^RCD(340,+DEBTOR,0),U,6)
.I VENDOR'="" S VENDORID=$$VEN^PRCHUTL(VENDOR) D Q
..I VENDORID="" S VENDORID="UNKNOWN" Q
..D STORE(BILLDA,VENDORID)
..Q
.I '$D(^XUSEC("PRCA VENDOR",DUZ)) S VENDORID="LINK" Q
.W !!,"DEBTOR MUST BE LINKED TO VENDOR FILE"
.S VENDOR=$$VENSEL^PRCHUTL()
.I VENDOR<0 S VENDORID="LINK" Q
.S VENDORID=$$VEN^PRCHUTL(VENDOR)
.I VENDORID="" S VENDORID="UNKNOWN" Q
.D STORE(BILLDA,VENDORID),STOREL(+DEBTOR,VENDOR)
.Q
;
; for ineligible send INELIG
I CATEGORY=1 D STORE(BILLDA,"INELIG") Q "INELIG"
; for ex-employee send XEMPL
I CATEGORY=15 D STORE(BILLDA,"XEMPL") Q "XEMPL"
; for current employee send CUREMPL
I CATEGORY=16 D STORE(BILLDA,"CUREMPL") Q "CUREMPL"
;
;
; for INELIGIBLE HOSP. REIMB.
; 841Z;INELI 3RD-PARTY INPATIENT
; 842Z;INELI 3RD-PARTY OUTPATIENT
I CATEGORY=47 D Q VENDORID
. S RSC=$P($G(^PRCA(430,BILLDA,11)),"^",6)
. I RSC'="" D Q
..I RSC="841Z" S VENDORID="INE3PINP"
..I RSC="842Z" S VENDORID="INE3POUT"
. D STORE(BILLDA,VENDORID)
;
; champva subsitence(27), champva third party(28)
I CATEGORY=27 D STORE(BILLDA,"CHMPVA1ST") Q "CHMPVA1ST"
I CATEGORY=28 D STORE(BILLDA,"CHMPVA3RD") Q "CHMPVA3RD"
; champva(29) does not get sent to FMS, code commented out
;I CATEGORY=29 Q ""
;
; tricare(30), tricare patient(31), tricare third party(32)
; test for tricare by looking at the revenue source code
S RSC=$P($G(^PRCA(430,BILLDA,11)),"^",6)
I RSC>8027,RSC<8031 D D STORE(BILLDA,VENDORID) Q VENDORID
.S VENDORID=$S(RSC=8028:"TRIINPAT",RSC=8029:"TRIOUTPAT",1:"TRIOTH")
.Q
I CATEGORY>29,CATEGORY<33 D D STORE(BILLDA,VENDORID) Q VENDORID
.S VENDORID=$S(CATEGORY=30:"TRICAROTH",CATEGORY=31:"TRICAROPT",1:"TRICARINP")
.Q
;
; for TRICARE SCI
; 8086;TRICARE SCI INPATIENT
; 8087;TRICARE SCI OUTPATIENT
; 8088;TRICARE SCI OTHER
I CATEGORY=76 D Q VENDORID
. S RSC=$P($G(^PRCA(430,BILLDA,11)),"^",6)
. I RSC'="" D Q
..I RSC="8086" S VENDORID="TRISCIINP"
..I RSC="8087" S VENDORID="TRISCIOPT"
..I RSC="8088" S VENDORID="TRISCIOTH"
. D STORE(BILLDA,VENDORID)
;
; for TRICARE TBI
; 8089;TRICARE TBI INPATIENT
; 8090;TRICARE TBI OUTPATIENT
; 8091;TRICARE TBI OTHER
I CATEGORY=77 D Q VENDORID
. S RSC=$P($G(^PRCA(430,BILLDA,11)),"^",6)
. I RSC'="" D Q
..I RSC="8089" S VENDORID="TRITBIINP"
..I RSC="8090" S VENDORID="TRITBIOPT"
..I RSC="8091" S VENDORID="TRITBIOTH"
. D STORE(BILLDA,VENDORID)
;
; for TRICARE BLIND REHABILITATION
; 8092;TRICARE BLIND REHABILITATION INPATIENT
; 8093;TRICARE BLIND REHABILITATION OUTPATIENT
; 8094;TRICARE BLIND REHABILITATION OTHER
I CATEGORY=78 D Q VENDORID
. S RSC=$P($G(^PRCA(430,BILLDA,11)),"^",6)
. I RSC'="" D Q
..I RSC="8092" S VENDORID="TRIBRINP"
..I RSC="8093" S VENDORID="TRIBROPT"
..I RSC="8094" S VENDORID="TRIBROTH"
. D STORE(BILLDA,VENDORID)
;
; Tricare Dental (79) and Tricare Pharmacy (80) Vendor IDs
I CATEGORY=79 D Q VENDORID
. S VENDORID="TRIDENTAL"
. D STORE(BILLDA,VENDORID)
I CATEGORY=80 D Q VENDORID
. S VENDORID="TRICARERX"
. D STORE(BILLDA,VENDORID)
I CATEGORY=75 D Q VENDORID
. S VENDORID="TRIDES"
. D STORE(BILLDA,VENDORID)
;
; vendor id not known, process should never reach this line of code
Q "UNKNOWN"
;
;
LINKASK ;ENTRY POINT FOR MENU OPTION TO STORE LINK
N DIC,Y
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
LINK ;LINKS DEBTOR TO VENDOR FILE
S VENDOR=$$VENSEL^PRCHUTL() I VENDOR<0 S VENDOR="LINK" Q
D STOREL(DEBTOR,VENDOR) Q
;
;
STOREL(DA,VENDOR) ; store the link from the debtor file to the vendor file
N D,D0,DI,DIC,DIE,DQ,DR,X,Y
S DR=".06////"_VENDOR_";"
S (DIC,DIE)="^RCD(340,"
D ^DIE
Q
;
;
STORE(DA,VENDORID) ;STORES THE VENDOR ID WITH THE BILL
I $G(^PRCA(430,DA,0))="" Q
N D0,DI,DIC,DIE,DQ,DR,X,Y,D
S DR="265////"_VENDORID_";"
S (DIC,DIE)="^PRCA(430,"
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCXFMSUV 5977 printed Oct 16, 2024@17:50:13 Page 2
RCXFMSUV ;WISC/RFJ-fms vendor id ;9/17/98 11:42 AM
+1 ;;4.5;Accounts Receivable;**90,119,98,165,192,220,315,338**;Mar 20, 1995;Build 69
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
VENDORID(BILLDA) ; return the vendorid for a bill (used on a BD document)
+1 ; returns null if vendor id is not required
+2 ; returns UNKNOWN if vendor id is required but could not be determined
+3 NEW ACCRUAL,CATEGORY,DEBTOR,RSC,VENDORID,VENDOR,DIR,VENFLAG
+4 ;
+5 ; accrued bills get sent to mccf 5287 fund, no vendor id
+6 SET ACCRUAL=$$ACCK^PRCAACC(BILLDA)
+7 ;
+8 ; if not a category, cannot determine vendor id
+9 SET CATEGORY=$PIECE($GET(^PRCA(430,BILLDA,0)),"^",2)
+10 IF 'CATEGORY
QUIT ""
+11 ;
IF ACCRUAL
QUIT ""
+12 ;
+13 ;
+14 ; if vendor(17) or military(12) or federal agencies refund(13)
+15 ; or federal agencies-reimb(14) or interagency(20)
+16 ; sharing agreements(19),nursing Home Proceeds (40)
+17 ; parking fees (41), cwt proceeds (42), comp & pen proceeds (43)
+18 ; Enhanced Use Lease Proceeds (44), then get vendor id
+19 SET VENFLAG=$SELECT(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,CATEGORY=47:1,1:0)
+20 IF VENFLAG
Begin DoDot:1
+21 SET DEBTOR=+$PIECE($GET(^PRCA(430,BILLDA,0)),"^",9)
SET VENDOR=$PIECE($GET(^RCD(340,DEBTOR,0)),U)
+22 IF VENDOR=""
SET VENDORID="UNKNOWN"
QUIT
+23 IF VENFLAG=2
IF VENDOR["VA("
SET VENDORID="PERSONOTH"
DO STORE(BILLDA,"PERSONOTH")
QUIT
+24 IF VENDOR["PRC("
Begin DoDot:2
+25 SET VENDORID=$$VEN^PRCHUTL(+VENDOR)
+26 IF VENDORID'=""
DO STORE(BILLDA,VENDORID)
QUIT
+27 IF VENFLAG=2
Begin DoDot:3
+28 SET DIR(0)="Y"
SET DIR("A")="Can this bill be offset by FMS "
+29 SET DIR("B")="YES"
DO ^DIR
+30 SET VENDORID=$SELECT(Y=0:"PERSONOTH",1:"UNKNOWN")
+31 if VENDORID="PERSONOTH"
DO STORE(BILLDA,"PERSONOTH")
+32 QUIT
End DoDot:3
QUIT
+33 SET VENDORID="UNKNOWN"
+34 QUIT
End DoDot:2
QUIT
+35 SET VENDOR=$PIECE(^RCD(340,+DEBTOR,0),U,6)
+36 IF VENDOR'=""
SET VENDORID=$$VEN^PRCHUTL(VENDOR)
Begin DoDot:2
+37 IF VENDORID=""
SET VENDORID="UNKNOWN"
QUIT
+38 DO STORE(BILLDA,VENDORID)
+39 QUIT
End DoDot:2
QUIT
+40 IF '$DATA(^XUSEC("PRCA VENDOR",DUZ))
SET VENDORID="LINK"
QUIT
+41 WRITE !!,"DEBTOR MUST BE LINKED TO VENDOR FILE"
+42 SET VENDOR=$$VENSEL^PRCHUTL()
+43 IF VENDOR<0
SET VENDORID="LINK"
QUIT
+44 SET VENDORID=$$VEN^PRCHUTL(VENDOR)
+45 IF VENDORID=""
SET VENDORID="UNKNOWN"
QUIT
+46 DO STORE(BILLDA,VENDORID)
DO STOREL(+DEBTOR,VENDOR)
+47 QUIT
End DoDot:1
QUIT VENDORID
+48 ;
+49 ; for ineligible send INELIG
+50 IF CATEGORY=1
DO STORE(BILLDA,"INELIG")
QUIT "INELIG"
+51 ; for ex-employee send XEMPL
+52 IF CATEGORY=15
DO STORE(BILLDA,"XEMPL")
QUIT "XEMPL"
+53 ; for current employee send CUREMPL
+54 IF CATEGORY=16
DO STORE(BILLDA,"CUREMPL")
QUIT "CUREMPL"
+55 ;
+56 ;
+57 ; for INELIGIBLE HOSP. REIMB.
+58 ; 841Z;INELI 3RD-PARTY INPATIENT
+59 ; 842Z;INELI 3RD-PARTY OUTPATIENT
+60 IF CATEGORY=47
Begin DoDot:1
+61 SET RSC=$PIECE($GET(^PRCA(430,BILLDA,11)),"^",6)
+62 IF RSC'=""
Begin DoDot:2
+63 IF RSC="841Z"
SET VENDORID="INE3PINP"
+64 IF RSC="842Z"
SET VENDORID="INE3POUT"
End DoDot:2
QUIT
+65 DO STORE(BILLDA,VENDORID)
End DoDot:1
QUIT VENDORID
+66 ;
+67 ; champva subsitence(27), champva third party(28)
+68 IF CATEGORY=27
DO STORE(BILLDA,"CHMPVA1ST")
QUIT "CHMPVA1ST"
+69 IF CATEGORY=28
DO STORE(BILLDA,"CHMPVA3RD")
QUIT "CHMPVA3RD"
+70 ; champva(29) does not get sent to FMS, code commented out
+71 ;I CATEGORY=29 Q ""
+72 ;
+73 ; tricare(30), tricare patient(31), tricare third party(32)
+74 ; test for tricare by looking at the revenue source code
+75 SET RSC=$PIECE($GET(^PRCA(430,BILLDA,11)),"^",6)
+76 IF RSC>8027
IF RSC<8031
Begin DoDot:1
+77 SET VENDORID=$SELECT(RSC=8028:"TRIINPAT",RSC=8029:"TRIOUTPAT",1:"TRIOTH")
+78 QUIT
End DoDot:1
DO STORE(BILLDA,VENDORID)
QUIT VENDORID
+79 IF CATEGORY>29
IF CATEGORY<33
Begin DoDot:1
+80 SET VENDORID=$SELECT(CATEGORY=30:"TRICAROTH",CATEGORY=31:"TRICAROPT",1:"TRICARINP")
+81 QUIT
End DoDot:1
DO STORE(BILLDA,VENDORID)
QUIT VENDORID
+82 ;
+83 ; for TRICARE SCI
+84 ; 8086;TRICARE SCI INPATIENT
+85 ; 8087;TRICARE SCI OUTPATIENT
+86 ; 8088;TRICARE SCI OTHER
+87 IF CATEGORY=76
Begin DoDot:1
+88 SET RSC=$PIECE($GET(^PRCA(430,BILLDA,11)),"^",6)
+89 IF RSC'=""
Begin DoDot:2
+90 IF RSC="8086"
SET VENDORID="TRISCIINP"
+91 IF RSC="8087"
SET VENDORID="TRISCIOPT"
+92 IF RSC="8088"
SET VENDORID="TRISCIOTH"
End DoDot:2
QUIT
+93 DO STORE(BILLDA,VENDORID)
End DoDot:1
QUIT VENDORID
+94 ;
+95 ; for TRICARE TBI
+96 ; 8089;TRICARE TBI INPATIENT
+97 ; 8090;TRICARE TBI OUTPATIENT
+98 ; 8091;TRICARE TBI OTHER
+99 IF CATEGORY=77
Begin DoDot:1
+100 SET RSC=$PIECE($GET(^PRCA(430,BILLDA,11)),"^",6)
+101 IF RSC'=""
Begin DoDot:2
+102 IF RSC="8089"
SET VENDORID="TRITBIINP"
+103 IF RSC="8090"
SET VENDORID="TRITBIOPT"
+104 IF RSC="8091"
SET VENDORID="TRITBIOTH"
End DoDot:2
QUIT
+105 DO STORE(BILLDA,VENDORID)
End DoDot:1
QUIT VENDORID
+106 ;
+107 ; for TRICARE BLIND REHABILITATION
+108 ; 8092;TRICARE BLIND REHABILITATION INPATIENT
+109 ; 8093;TRICARE BLIND REHABILITATION OUTPATIENT
+110 ; 8094;TRICARE BLIND REHABILITATION OTHER
+111 IF CATEGORY=78
Begin DoDot:1
+112 SET RSC=$PIECE($GET(^PRCA(430,BILLDA,11)),"^",6)
+113 IF RSC'=""
Begin DoDot:2
+114 IF RSC="8092"
SET VENDORID="TRIBRINP"
+115 IF RSC="8093"
SET VENDORID="TRIBROPT"
+116 IF RSC="8094"
SET VENDORID="TRIBROTH"
End DoDot:2
QUIT
+117 DO STORE(BILLDA,VENDORID)
End DoDot:1
QUIT VENDORID
+118 ;
+119 ; Tricare Dental (79) and Tricare Pharmacy (80) Vendor IDs
+120 IF CATEGORY=79
Begin DoDot:1
+121 SET VENDORID="TRIDENTAL"
+122 DO STORE(BILLDA,VENDORID)
End DoDot:1
QUIT VENDORID
+123 IF CATEGORY=80
Begin DoDot:1
+124 SET VENDORID="TRICARERX"
+125 DO STORE(BILLDA,VENDORID)
End DoDot:1
QUIT VENDORID
+126 IF CATEGORY=75
Begin DoDot:1
+127 SET VENDORID="TRIDES"
+128 DO STORE(BILLDA,VENDORID)
End DoDot:1
QUIT VENDORID
+129 ;
+130 ; vendor id not known, process should never reach this line of code
+131 QUIT "UNKNOWN"
+132 ;
+133 ;
LINKASK ;ENTRY POINT FOR MENU OPTION TO STORE LINK
+1 NEW DIC,Y
+2 SET DIC=340
SET DIC(0)="AEQM"
SET DIC("A")="Enter Debtor to be linked to Vendor File: "
SET DIC("S")="I $P(^RCD(340,+Y,0),U)'[""PRC("""
DO ^DIC
if Y<0
QUIT
SET DEBTOR=+Y
LINK ;LINKS DEBTOR TO VENDOR FILE
+1 SET VENDOR=$$VENSEL^PRCHUTL()
IF VENDOR<0
SET VENDOR="LINK"
QUIT
+2 DO STOREL(DEBTOR,VENDOR)
QUIT
+3 ;
+4 ;
STOREL(DA,VENDOR) ; store the link from the debtor file to the vendor file
+1 NEW D,D0,DI,DIC,DIE,DQ,DR,X,Y
+2 SET DR=".06////"_VENDOR_";"
+3 SET (DIC,DIE)="^RCD(340,"
+4 DO ^DIE
+5 QUIT
+6 ;
+7 ;
STORE(DA,VENDORID) ;STORES THE VENDOR ID WITH THE BILL
+1 IF $GET(^PRCA(430,DA,0))=""
QUIT
+2 NEW D0,DI,DIC,DIE,DQ,DR,X,Y,D
+3 SET DR="265////"_VENDORID_";"
+4 SET (DIC,DIE)="^PRCA(430,"
