Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCXFMSUV

RCXFMSUV.m

Go to the documentation of this file. 
  1. 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
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  Q
  1.  ;
  1.  ;
  1. VENDORID(BILLDA) ;  return the vendorid for a bill (used on a BD document)
  1.  ;  returns null if vendor id is not required
  1.  ;  returns UNKNOWN if vendor id is required but could not be determined
  1.  N ACCRUAL,CATEGORY,DEBTOR,RSC,VENDORID,VENDOR,DIR,VENFLAG
  1.  ;
  1.  ;  accrued bills get sent to mccf 5287 fund, no vendor id
  1.  S ACCRUAL=$$ACCK^PRCAACC(BILLDA)
  1.  ;
  1.  ;  if not a category, cannot determine vendor id
  1.  S CATEGORY=$P($G(^PRCA(430,BILLDA,0)),"^",2)
  1.  I 'CATEGORY Q ""
  1.  I ACCRUAL Q "" ;
  1.  ;
  1.  ;
  1.  ;  if vendor(17) or military(12) or federal agencies refund(13)
  1.  ;  or federal agencies-reimb(14) or interagency(20)
  1.  ;  sharing agreements(19),nursing Home Proceeds (40)
  1.  ;  parking fees (41), cwt proceeds (42), comp & pen proceeds (43)
  1.  ;  Enhanced Use Lease Proceeds (44), then get vendor id
  1.  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)
  1.  I VENFLAG D  Q VENDORID
  1.     .S DEBTOR=+$P($G(^PRCA(430,BILLDA,0)),"^",9),VENDOR=$P($G(^RCD(340,DEBTOR,0)),U)
  1.     .I VENDOR="" S VENDORID="UNKNOWN" Q
  1.     .I VENFLAG=2,VENDOR["VA(" S VENDORID="PERSONOTH" D STORE(BILLDA,"PERSONOTH") Q
  1.     .I VENDOR["PRC(" D  Q
  1.        ..S VENDORID=$$VEN^PRCHUTL(+VENDOR)
  1.        ..I VENDORID'="" D STORE(BILLDA,VENDORID) Q
  1.        ..I VENFLAG=2 D  Q
  1.          ...S DIR(0)="Y",DIR("A")="Can this bill be offset by FMS "
  1.          ...S DIR("B")="YES" D ^DIR
  1.          ...S VENDORID=$S(Y=0:"PERSONOTH",1:"UNKNOWN")
  1.          ...D:VENDORID="PERSONOTH" STORE(BILLDA,"PERSONOTH")
  1.          ...Q
  1.        ..S VENDORID="UNKNOWN"
  1.        ..Q
  1.     .S VENDOR=$P(^RCD(340,+DEBTOR,0),U,6)
  1.     .I VENDOR'="" S VENDORID=$$VEN^PRCHUTL(VENDOR) D  Q
  1.        ..I VENDORID="" S VENDORID="UNKNOWN" Q
  1.        ..D STORE(BILLDA,VENDORID)
  1.        ..Q
  1.     .I '$D(^XUSEC("PRCA VENDOR",DUZ)) S VENDORID="LINK" Q
  1.     .W !!,"DEBTOR MUST BE LINKED TO VENDOR FILE"
  1.     .S VENDOR=$$VENSEL^PRCHUTL()
  1.     .I VENDOR<0 S VENDORID="LINK" Q
  1.     .S VENDORID=$$VEN^PRCHUTL(VENDOR)
  1.     .I VENDORID="" S VENDORID="UNKNOWN" Q
  1.     .D STORE(BILLDA,VENDORID),STOREL(+DEBTOR,VENDOR)
  1.     .Q
  1.  ;
  1.  ;  for ineligible send INELIG
  1.  I CATEGORY=1 D STORE(BILLDA,"INELIG") Q "INELIG"
  1.  ;  for ex-employee send XEMPL
  1.  I CATEGORY=15 D STORE(BILLDA,"XEMPL") Q "XEMPL"
  1.  ;  for current employee send CUREMPL
  1.  I CATEGORY=16 D STORE(BILLDA,"CUREMPL") Q "CUREMPL"
  1.  ;
  1.  ;
  1.  ;  for INELIGIBLE HOSP. REIMB. 
  1.  ;  841Z;INELI  3RD-PARTY INPATIENT
  1.  ;  842Z;INELI  3RD-PARTY OUTPATIENT 
  1.  I CATEGORY=47 D   Q VENDORID
  1.  . S RSC=$P($G(^PRCA(430,BILLDA,11)),"^",6)
  1.  . I RSC'="" D  Q
  1.  ..I RSC="841Z" S VENDORID="INE3PINP"
  1.  ..I RSC="842Z" S VENDORID="INE3POUT"
  1.  . D STORE(BILLDA,VENDORID)
  1.  ;
  1.  ;  champva subsitence(27), champva third party(28)
  1.  I CATEGORY=27 D STORE(BILLDA,"CHMPVA1ST") Q "CHMPVA1ST"
  1.  I CATEGORY=28 D STORE(BILLDA,"CHMPVA3RD") Q "CHMPVA3RD"
  1.  ;  champva(29) does not get sent to FMS, code commented out
  1.  ;I CATEGORY=29 Q ""
  1.  ;
  1.  ;  tricare(30), tricare patient(31), tricare third party(32)
  1.  ;  test for tricare by looking at the revenue source code
  1.  S RSC=$P($G(^PRCA(430,BILLDA,11)),"^",6)
  1.  I RSC>8027,RSC<8031 D  D STORE(BILLDA,VENDORID) Q VENDORID
  1.     .S VENDORID=$S(RSC=8028:"TRIINPAT",RSC=8029:"TRIOUTPAT",1:"TRIOTH")
  1.     .Q
  1.  I CATEGORY>29,CATEGORY<33 D  D STORE(BILLDA,VENDORID) Q VENDORID
  1.     .S VENDORID=$S(CATEGORY=30:"TRICAROTH",CATEGORY=31:"TRICAROPT",1:"TRICARINP")
  1.     .Q
  1.  ;
  1.  ;  for TRICARE SCI 
  1.  ;  8086;TRICARE SCI INPATIENT
  1.  ;  8087;TRICARE SCI OUTPATIENT 
  1.  ;  8088;TRICARE SCI OTHER 
  1.  I CATEGORY=76 D   Q VENDORID
  1.  . S RSC=$P($G(^PRCA(430,BILLDA,11)),"^",6)
  1.  . I RSC'="" D  Q
  1.  ..I RSC="8086" S VENDORID="TRISCIINP"
  1.  ..I RSC="8087" S VENDORID="TRISCIOPT"
  1.  ..I RSC="8088" S VENDORID="TRISCIOTH"
  1.  . D STORE(BILLDA,VENDORID)
  1.  ;
  1.  ;  for TRICARE TBI 
  1.  ;  8089;TRICARE TBI INPATIENT
  1.  ;  8090;TRICARE TBI OUTPATIENT 
  1.  ;  8091;TRICARE TBI OTHER 
  1.  I CATEGORY=77 D   Q VENDORID
  1.  . S RSC=$P($G(^PRCA(430,BILLDA,11)),"^",6)
  1.  . I RSC'="" D  Q
  1.  ..I RSC="8089" S VENDORID="TRITBIINP"
  1.  ..I RSC="8090" S VENDORID="TRITBIOPT"
  1.  ..I RSC="8091" S VENDORID="TRITBIOTH"
  1.  . D STORE(BILLDA,VENDORID)
  1.  ;
  1.  ;  for TRICARE BLIND REHABILITATION 
  1.  ;  8092;TRICARE BLIND REHABILITATION INPATIENT
  1.  ;  8093;TRICARE BLIND REHABILITATION OUTPATIENT 
  1.  ;  8094;TRICARE BLIND REHABILITATION OTHER 
  1.  I CATEGORY=78 D   Q VENDORID
  1.  . S RSC=$P($G(^PRCA(430,BILLDA,11)),"^",6)
  1.  . I RSC'="" D  Q
  1.  ..I RSC="8092" S VENDORID="TRIBRINP"
  1.  ..I RSC="8093" S VENDORID="TRIBROPT"
  1.  ..I RSC="8094" S VENDORID="TRIBROTH"
  1.  . D STORE(BILLDA,VENDORID)
  1.  ;
  1.  ; Tricare Dental (79) and Tricare Pharmacy (80) Vendor IDs
  1.  I CATEGORY=79 D  Q VENDORID
  1.  . S VENDORID="TRIDENTAL"
  1.  . D STORE(BILLDA,VENDORID)
  1.  I CATEGORY=80 D   Q VENDORID
  1.  . S VENDORID="TRICARERX"
  1.  . D STORE(BILLDA,VENDORID)
  1.  I CATEGORY=75 D   Q VENDORID
  1.  . S VENDORID="TRIDES"
  1.  . D STORE(BILLDA,VENDORID)
  1.  ;
  1.  ;  vendor id not known, process should never reach this line of code
  1.  Q "UNKNOWN"
  1.  ;
  1.  ;
  1. LINKASK ;ENTRY POINT FOR MENU OPTION TO STORE LINK
  1.  N DIC,Y
  1.  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
  1.  S VENDOR=$$VENSEL^PRCHUTL() I VENDOR<0 S VENDOR="LINK" Q
  1.  D STOREL(DEBTOR,VENDOR) Q
  1.  ;
  1.  ;
  1. STOREL(DA,VENDOR) ;  store the link from the debtor file to the vendor file
  1.  N D,D0,DI,DIC,DIE,DQ,DR,X,Y
  1.  S DR=".06////"_VENDOR_";"
  1.  S (DIC,DIE)="^RCD(340,"
  1.  D ^DIE
  1.  Q
  1.  ;
  1.  ;
  1. STORE(DA,VENDORID) ;STORES THE VENDOR ID WITH THE BILL
  1.  I $G(^PRCA(430,DA,0))="" Q
  1.  N D0,DI,DIC,DIE,DQ,DR,X,Y,D
  1.  S DR="265////"_VENDORID_";"
  1.  S (DIC,DIE)="^PRCA(430,"