FBPAID3A ;DSS/SCR - Utilities to support FEE BASIS PAID TO IB Process ;3/28/1012
 ;;3.5;FEE BASIS;**135**;JAN 30, 1995;Build 3
 ;;Per VHA Directive 2004-038, this routine should not be modified.
 ;
 ;; DBIA SUPPORTED REF CHKDGT^XUSNPI
 Q
 ;
 ;
PRCFBREC(FBIEN,FBRECARY,FBARRY,FBCHECK) ;Processes one Fee Basis record
 ;                                       
 ; INPUT : FBIEN - the IEN of the FEE BASIS TO IB file line being processed
 ;         FBRECARY - AN array populated with information about the FEE BASIS INVOICE
 ;         FBARRY - An array used to update the FEE BASIS PAID TO IB file
 ;         FBCHECK - An array passed by reference which holds processed NPIs
 ;  
 ; OUTPUT: FBARRY populated with line item provider information
 ;         FBCHECK populated with information about each NPI which has been processed
 ;         'FBQUIT - 1 if no problems stopped processing, 0 if they did
 ;
 N FBDUZ,FBPRVTYP,FBVDRIEN,FBATDNAM,FBATDNPI,FBATDTXY,FBOPRNAM,FBOPRNPI,FBOPRTXY
 N FBRNDNAM,FBRNDNPI,FBRNDTXY,FBSRVNAM,FBSRVNPI,FBSRVTXY,FBREFNAM,FBREFNPI,FBREFTXY
 N FBLIRNAM,FBLIRNPI,FBLIRTXY
 N FBINFO,FBIBIEN,FBNPIFLG,FBTXYFLG,FBOK,FBQUIT,FBNIEN,FBBADNPI
 ;
 S FBQUIT=0
 ;
 S FBDUZ=$$GETFBDUZ(FBRECARY("BATCH NUMBER"))
 ;FIRST add the PRIMARY provider info
 S FBPRVTYP="1"   ;FIRST WE LOOK FOR/ADD A FACILITY PROVIDER IN THE IB FILE
 S FBVDRIEN=FBRECARY("VENDOR INTERNAL")
 I FBVDRIEN<0 S FBQUIT=1  ;if we don't have a valid VENDOR we won't be sending a bill out
 I 'FBQUIT D
 .S FBATDNAM=FBRECARY("ATTENDING NAME")
 .S FBOPRNAM=FBRECARY("OPERATING NAME")
 .S FBRNDNAM=FBRECARY("RENDERING NAME")
 .S FBSRVNAM=FBRECARY("SERVICING NAME")
 .S FBREFNAM=FBRECARY("REFERRING NAME")
 .S FBPRVNAM=""
 .S FBPRVNPI=""
 .S FBPRVTXY=""
 .S FBINFO=$$FBTOIB(FBVDRIEN,FBPRVNAM,FBPRVTYP,FBPRVNPI,FBPRVTXY,FBDUZ,.FBCHECK)
 .S FBIBIEN=$P(FBINFO,U,1)
 .S FBNPIFLG=$P(FBINFO,U,2)
 .S FBTXYFLG=$P(FBINFO,U,3)
 .S FBOK=$$UPDTONE(FBIEN,"V",FBIBIEN,FBNPIFLG,FBTXYFLG,.FBARRY)  ;UPDATES FEE BASIS PAID WITH RESULTS FOR THIS PROVIDER
 .Q:FBNPIFLG=0
 .;ADD SERVICING PROVIDER INFORMATION AS A TYPE 1 PROVIDER
 .I FBSRVNAM'="" D
 ..N FBSRVINF,FBNIEN
 ..S FBSRVNPI=$G(FBRECARY("SERVICING NPI"))
 ..S FBSRVTXY=$G(FBRECARY("SERVICING TXY"))
 ..S FBSRVTXY=""
 ..S FBSRVINF("ADDRESS")=FBRECARY("SERVICING ADDRESS")
 ..S FBSRVINF("CITY")=FBRECARY("SERVICING CITY")
 ..S FBSRVINF("STATE")=FBRECARY("SERVICING STATE INT")
 ..S FBSRVINF("ZIP")=FBRECARY("SERVICING ZIP")
 ..S FBINFO=$$FBTOIB("",FBSRVNAM,FBPRVTYP,FBSRVNPI,FBSRVTXY,FBDUZ,.FBCHECK,.FBSRVINF)
 ..S FBIBIEN=$P(FBINFO,U,1)  ;THIS IS "" IF NO UPDATES WERE MADE, the IB record if it was found/updated
 ..S FBNPIFLG=$P(FBINFO,U,2)
 ..S FBTXYFLG=$P(FBINFO,U,3)
 ..S FBNIEN=$$ADD5010(FBARRY("PROGRAM INTERNAL"),FBARRY("FBICN"),FBARRY("PATIENT INTERNAL"),FBARRY("PROCESS DATE INTERNAL"),FBARRY("LI NUMBER"))
 ..Q:'+FBNIEN
 ..S FBOK=$$UPDTONE(FBNIEN,"S",FBIBIEN,FBNPIFLG,FBTXYFLG,.FBARRY)  ;UPDATES FEE BASIS PAID WITH RESULTS FOR THIS PROVIDER
 .;MAKE A TYPE "2" PROVIDER ENTRY FOR EACH 5010 PROVIDER EXCEPT SERVICING
 .S FBPRVTYP="2"  ;AN INDIVIDUAL TYPE PROVIDER IN THE IB NON/OTHER VA BILLING PROVIDER FILE
 .I FBATDNAM'="" D
 ..S FBATDNPI=FBRECARY("ATTENDING NPI")
 ..S FBATDTXY=FBRECARY("ATTENDING TXY")
 ..S FBOK=$$TYPETWO("A",FBATDNAM,FBATDNPI,FBATDTXY,FBDUZ,.FBARRAY,.FBCHECK)
 .I FBOPRNAM'="" D
 ..S FBOPRNPI=FBRECARY("OPERATING NPI")
 ..S FBOPRTXY=""
 ..S FBOK=$$TYPETWO("O",FBOPRNAM,FBOPRNPI,FBOPRTXY,FBDUZ,.FBARRAY,.FBCHECK)
 .I FBRNDNAM'="" D
 ..S FBRNDNPI=FBRECARY("RENDERING NPI")
 ..S FBRNDTXY=FBRECARY("RENDERING TXY")
 ..S FBOK=$$TYPETWO("R",FBRNDNAM,FBRNDNPI,FBRNDTXY,FBDUZ,.FBARRAY,.FBCHECK)
 .I FBREFNAM'="" D
 ..S FBREFNPI=FBRECARY("REFERRING NPI")
 ..S FBREFTXY=""
 ..S FBOK=$$TYPETWO("F",FBREFNAM,FBREFNPI,FBREFTXY,FBDUZ,.FBARRAY,.FBCHECK)
 .I FBARRY("PROGRAM INTERNAL")=3  D
 ..;ADD LINE ITEM RENDERING PROVIDER FOR OUPATIENT
 ..S FBLIRNAM=FBRECARY("LI RENDERING NAME")
 ..S FBLIRNPI=FBRECARY("LI RENDERING NPI")
 ..S FBLIRTXY=FBRECARY("LI RENDERING TXY")
 ..I FBLIRNAM'="" S FBOK=$$TYPETWO("L",FBLIRNAM,FBLIRNPI,FBLIRTXY,FBDUZ,.FBARRAY,.FBCHECK)
 .I FBARRY("PROGRAM INTERNAL")=9 D
 ..;ADD A LINE FOR EACH INPATIENT LINE ITEM RENDERING INFO
 ..S FBLINUM=0
 ..F  S FBLINUM=$O(FBRECARY("LIRENDER NAME",FBLINUM)) Q:FBLINUM=""  D
 ...S FBLIRNAM=$G(FBRECARY("LIRENDER NAME",FBLINUM))
 ...S FBLIRNPI=$G(FBRECARY("LIRENDER NPI",FBLINUM))
 ...S FBLIRTXY=$G(FBRECARY("LIRENDER TXY",FBLINUM))
 ...S FBARRY("LI NUMBER")=$G(FBRECARY("LINE ITEM NUMBER",FBLINUM))
 ...S FBOK=$$TYPETWO("L",FBLIRNAM,FBLIRNPI,FBLIRTXY,FBDUZ,.FBARRAY,.FBCHECK)
 Q 'FBQUIT
 ;
UPDTONE(FBIEN,FBTYP,FBIBICN,FBNPIFLG,FBTXYFLG,FBARRY)  ;UPDATES a record in 161.9
 ;
 ; INPUT FBIEN : IEN OF FEE BASIS PAID TO IB file being updated
 ;       FBTYP: INTERNAL value of set of codes identifying provider type
 ;       FBIBICN  : IEN OF IB NON/VA OTHER BILLING PROVIDER file that was added or looked up
 ;
 ;       FBNPIFLG : '0' FOR NO NPI DATA PROVIDED;
 ;                  '1' FOR NPI DATA INVALID;
 ;                  '2' FOR NPI MATCHED ACTIVE, NO UPDATES;
 ;                  '3' FOR NPI MATCHED ACTIVE, IB UPDATED;
 ;                  '4' FOR NPI MATCHED INACTIVE, NO UPDATES;
 ;                  '5' FOR NPI NEW, IB RECORD CREATED;
 ;
 ;       FBTXYFLG : '0' FOR NO TXY UPDATES ATTEMPTED;
 ;                  '1' FOR TXY CODE NOT FOUND IN 8932.1;
 ;                  '2' FOR MATCHED PRIMARY,NO UPDATES;
 ;                  '3' FOR MATCHED NON-PRIMARY, IB TXY UPDATES;
 ;                  '4' FOR NEW, IB TXY ENTRY CREATED;
 ;
 ;       FBARRY : ARRAY populated with initial values from lookup
 ;
 N FBOK,FBERR
 ;
 S FBARRY("PROVIDER TYPE")=FBTYP ; INTERNAL CODE FOR PRIMARY
 S FBARRY("IBICN")=$G(FBIBICN)   ;CAN BE NULL
 S FBARRY("NPI ADDED")=FBNPIFLG ;
 S FBARRY("TXY ADDED")=FBTXYFLG ;
 S FBOK=$$SETFB2IB^FBPAID3(FBIEN,.FBARRY)
 Q FBOK
 ;
FBTOIB(FBVDRIEN,FBPRVNAM,FBPRVTYP,FBPRVNPI,FBPRVTXY,FBDUZ,FBCHECK,FBSRVINF)   ;
 ; PROCESSES information about one FB PROVIDER
 ;
 ; INPUTS  :  FBVDRIEN  : AN IEN to FEE BASIS VENDOR FILE
 ;            FBPRVNAM  : A STRING OF TEXT FROM FB FILES REPRESENTING THE PROVIDER NAME
 ;            FBPRVTYP  : "1" FOR FACILITY TYPE PROVIDER ;  "2" FOR INDIVIDUAL
 ;            FBPRVNPI  : A STRING OF TEXT FROM FB FILES REPRESENTING THE PROVIDER NPI
 ;            FBPRVTXY  : A STRING OF TEXT FROM FB FILES REPRESENTING A SUPPORTING PROVIDER TAXONOMY CODE
 ;            FBDUZ     ; FB USER DUZ WHO LAST UPDATED THE FB FILE INFO IS COMING FROM
 ;            FBSRVINF  : AN ARRAY OF INFORMATION FOR A SERVICING PROVIDER (TYPE 1) 
 ;                            WILL BE NULL UNLESS THIS IS BEING CALLED TO ADD A SERVICING PROVIDER
 ;
 ;            FBCHECK   ; AN ARRAY OF NPIs that have been previously examined for this date
 ;
 ; OUTPUT :    A three piece string with information about how attempted updates went
 ;        :    FBCHECK will contain information about NPIs that are 'new' for this date
 ;
 N FBQUIT,FBRTRN,FBIBIEN,FBIENS,FBFLDS,FBFLGS,FBINDX,FBSCRN,FBIDNT,FBINFO,FBBADNPI,FBNEW,FBRETRN
 ;
 S FBINFO("FBPRVTYP")=FBPRVTYP   ;"1" OR "2" for IB FACILITY or IB INDIVIDUAL
 S FBQUIT=0
 S FBIBIEN=-1
 I FBPRVNAM="" D
 .I '+FBVDRIEN S FBPRVTYP=-1
 I FBPRVNAM'="" D
 .I ($L($G(FBPRVNAM))>30) S FBPRVNAM=$E(FBPRVNAM,1,30)
 .I ($L($G(FBPRVNAM))<3) S FBPRVTYP=-1  ;
 S FBINFO("FB SUP DUZ")=FBDUZ
 S FBINFO("NAME")=FBPRVNAM
 I (FBPRVTYP="1") D
 .I FBVDRIEN'="" D
 ..;LOOK UP THE PROVIDER IN THE FEE BASIS VENDOR FILE
 ..;(#.01) NAME [1F] ^ (#1) ID NUMBER [2F] ^ (#2) STREET ADDRESS[3F] ^(#2.5) STREET ADDRESS 2 [14F]
 ..;^ (#3) CITY [4F] ^ (#4) STATE [5P:5] ^ (#5) ZIP CODE [6F]^(#14) PHONE NUMBER [1F] ;(#41.01) NPI (#42) TAXONOMY CODE [3F]
 ..I '+FBVDRIEN S FBPRVTYP=-1 Q
 ..S FBFLDS=".01;1;2;2.5;3;4;5;14;41.01;42"
 ..D GETS^DIQ(161.2,FBVDRIEN_",",FBFLDS,"IE","FBRTRN","FBERR")  ;161.2  ;FEE BASIS VENDOR
 ..I $G(FBERR("DIERR"))'="" S FBPRVTYP=-1 Q
 ..S FBINFO("NAME")=$G(FBRTRN(161.2,FBVDRIEN_",",".01","I"))
 ..I $L(FBINFO("NAME"))>30 S FBINFO("NAME")=$E(FBINFO("NAME"),1,30)
 ..S FBPRVNAM=FBINFO("NAME")
 ..S FBINFO("FBFACID")=$G(FBRTRN(161.2,FBVDRIEN_",","1","I"))
 ..S FBINFO("FBADD1")=$G(FBRTRN(161.2,FBVDRIEN_",","2","I"))
 ..S FBINFO("FBADD2")=$G(FBRTRN(161.2,FBVDRIEN_",","2.5","I"))
 ..S FBINFO("FBCITY")=$G(FBRTRN(161.2,FBVDRIEN_",","3","I"))
 ..S FBINFO("FBSTATE")=$G(FBRTRN(161.2,FBVDRIEN_",","4","E"))
 ..S FBINFO("FBSTATE INT")=$G(FBRTRN(161.2,FBVDRIEN_",","4","I"))  ;this is pointer to state file
 ..S FBINFO("FBZIP")=$G(FBRTRN(161.2,FBVDRIEN_",","5","I"))
 ..S FBINFO("FBPHONE")=$G(FBRTRN(161.2,FBVDRIEN_",","14","I"))
 ..S FBINFO("FBNPI")=$G(FBRTRN(161.2,FBVDRIEN_",","41.01","I"))
 ..S FBINFO("FBTXY")=$G(FBRTRN(161.2,FBVDRIEN_",","42","I"))
 ..S FBINFO("IB TYPE")=1
 .I FBVDRIEN="" D 
 ..;ADDING A SERVICING PROVIDER with address info from the FEE BASIS INVOICE or PAYMENT file
 ..S FBINFO("FBADD1")=$G(FBSRVINF("ADDRESS"))
 ..S FBINFO("FBADD2")=""
 ..S FBINFO("FBCITY")=$G(FBSRVINF("CITY"))
 ..S FBINFO("FBSTATE INT")=$G(FBSRVINF("STATE"))  ;this is pointer to state file
 ..S FBINFO("FBZIP")=$G(FBSRVINF("ZIP"))
 ..S FBINFO("FBNPI")=$G(FBPRVNPI)
 ..S FBINFO("FBTXY")=$G(FBPRVTXY)
 ..S FBINFO("IB TYPE")=1
 .S FBPRVNPI=FBINFO("FBNPI")
 .S FBPRVTXY=FBINFO("FBTXY")
 .;Check to see if NPI has been processed for this process date
 .I $G(FBPRVNPI)="" S FBPRVNPI=0
 .I $G(FBCHECK(FBPRVNPI))'="" D
 ..S:$P(FBCHECK(FBPRVNPI),U,2)'=1 FBNEW=$P(FBCHECK(FBPRVNPI),U,1)_"^0^0" ;IBRECORD^NO UPDATES ATTEMPTED ^ NO TXY UPDATES ATTEMPTED
 ..S:$P(FBCHECK(FBPRVNPI),U,2)'=1 FBNEW=FBCHECK(FBPRVNPI)  ; "^1^0" ;NPI INVALID, no IB record
 .Q:$G(FBNEW)'=""
 .S FBBADNPI=0
 .S:$G(FBPRVNPI)="" FBPRVNPI=0
 .Q:$G(FBPRVNPI)=""
 .I $L(FBPRVNPI)>10!($L(FBPRVNPI)<10)!('$$CHKDGT^XUSNPI(FBPRVNPI)) S FBBADNPI=1
 .I 'FBBADNPI D 
 ..D EPFBAPI^IBCEP8C(.FBINFO,.FBRETRN)  ;compares/updates 355.93 -- IB NON/OTHER VA BILLING PROVIDER FILE
 ..S FBNEW=FBRETRN(1)_"^"_FBRETRN(2)_"^"_FBRETRN(3)
 .I FBBADNPI S FBNEW="^1^0"
 .S FBCHECK(FBPRVNPI)=FBNEW
 I FBPRVTYP="2" D
 .;NO LOOK UP TO FB FILES OCCURS- THIS IS NOT A BILLING PROVIDER AND WON'T BE IN THE FEE BASIS VENDOR FILE
 .S FBINFO("NAME")=FBPRVNAM
 .S FBINFO("FBNPI")=FBPRVNPI
 .S FBINFO("FBTXY")=FBPRVTXY
 .S FBINFO("IB TYPE")=2
 .I $G(FBPRVNPI)="" S FBPRVNPI=0
 .I $G(FBCHECK(FBPRVNPI))'="" S FBNEW=$G(FBCHECK(FBPRVNPI))
 .I $G(FBNEW)="" D
 ..S FBBADNPI=0
 ..I $L(FBPRVNPI)>10!($L(FBPRVNPI)<10)!('$$CHKDGT^XUSNPI(FBPRVNPI)) S FBBADNPI=1
 ..I 'FBBADNPI D
 ...D EPFBAPI^IBCEP8C(.FBINFO,.FBRETRN)  ;compares/updates 355.93 -- IB NON/OTHER VA BILLING PROVIDER FILE
 ...S:FBRETRN(1)'="" FBNEW=FBRETRN(1)_"^"_FBRETRN(2)_"^"_FBRETRN(3)
 ...S:FBRETRN(1)="" FBNEW="^0^0"   ;problems adding or finding provider, so no other updates attempted
 ..I FBBADNPI S FBNEW="^1^0"
 .Q:FBBADNPI
 S:FBPRVTYP=-1 FBNEW="^0^0"  ;
 Q FBNEW   ;A THREE PIECE STRING OF INFORMATION ABOUT HOW UPDATES WENT
 ;
ADD5010(FBPROG,FBICN,FBPAT,FBDATE,FBLINUM) ;EP FROM FBPAID AND FBPAID3A
 ; INPUT  : 
 ;          FBPROG : "3" FOR OUTPATIENT, "9" FOR INPATIENT
 ;          FBICN  : A FOUR PIECE ';' DELIMITED STRING
 ;          FBPAT  : POINTER TO THE PATIENT FILE
 ;          FBDATE : DATE OF MM MESSAGE FROM CENTRAL FEE PROCESSING
 ;
 ; OUPUT  : ien of new entry or -1 if problems occur
 ;
 N FBARRY,FBOK,FBERR
 ;
 S FBARRY("PATIENT")=FBPAT  ;INTERNAL
 S FBARRY("PROGRAM")=FBPROG
 I $G(FBPROG)=3 D
 .S FBARRY("FBICN")=FBICN
 .S FBARRY("LI NUMBER")=FBLINUM
 I $G(FBPROG)=9 D
 .S FBARRY("FBICN")=FBICN
 S FBARRY("PROCESS DATE")=FBDATE   ;INTERNAL Date message started getting processed
 S FBOK=$$SETFB2IB^FBPAID3("",.FBARRY)  ;returns the ien of a new line, or -1
 Q FBOK
 ;
TYPETWO(FB5010TYP,FBPRVNAM,FBPRVNPI,FBPRVTXY,FBDUZ,FBARRAY,FBCHECK)   ;process IB INDIVIDUAL providers
 ; Validates NPI information for IB INDIVIDUAL (type 2) providers, and calls the IBAPI if the NPI is
 ;    valid and has not already been processed for the current processing date.
 ;
 ; Updates the FEE BASIS PAID TO IB file with the results of validation/update
 ;
 ; INPUT  :   FB5010TYP ('A','O','R','S','F','L')
 ;            FBPRVNAM   - The name of a type 2 provider
 ;            FBPRVNPI  - The NPI of a type 2 provider
 ;            FBPRVTXY  - Taxonomy code of a type 2 provider (can be null)
 ;            FBDUZ      - IEN of supervisor who validated batch the fee basis record is in
 ;            FBARRAY  - an array of information about the fee basis record being processed
 ;            FBCHECK - an array of information about NPIs which have already been dealt with
 ;
 ;  OUTPUT : FBCHECK is updated with information about any NPI which is not already represented
 ;           FBOK - IEN of record added or -1 if problems occurred
 ;
 N FBBADNPI,FBIBIEN2,FBNPIFLG,FBTXYFLG,FBNIEN,FBOK
 ;
 S FBIBIEN2=""
 S FBBADNPI=0
 S FBOK=0
 S:$G(FBPRVNPI)="" FBPRVNPI=0
 I $G(FBCHECK(FBPRVNPI))'="" D
 .S FBIBIEN2=$P($G(FBCHECK(FBPRVNPI)),U,1)  ;a record we found or added tonight or NULL
 .S:$P($G(FBCHECK(FBPRVNPI)),U,2)'=1 FBNPIFLG=0   ;NO NPI UPDATES ATTEMPTED
 .S:$P($G(FBCHECK(FBPRVNPI)),U,2)=1 FBNPIFLG=1  ;NPI INVALID
 .S FBTXYFLG=0   ; NO TXY UPDATES ATTEMPTED
 I $G(FBCHECK(FBPRVNPI))="" D
 .I $L(FBPRVNPI)>10!($L(FBPRVNPI)<10)!('$$CHKDGT^XUSNPI(FBPRVNPI)) S FBBADNPI=1
 .I FBBADNPI S FBCHECK(FBPRVNPI)="^1^0"   ;INVALID NPI
 .I 'FBBADNPI S FBCHECK(FBPRVNPI)=$$FBTOIB("",FBPRVNAM,2,FBPRVNPI,FBPRVTXY,FBDUZ,.FBCHECK)
 .S FBIBIEN2=$P($G(FBCHECK(FBPRVNPI)),U,1)
 .S FBNPIFLG=$P($G(FBCHECK(FBPRVNPI)),U,2)
 .S FBTXYFLG=$P($G(FBCHECK(FBPRVNPI)),U,3)
 S FBNIEN=$$ADD5010(FBARRY("PROGRAM INTERNAL"),FBARRY("FBICN"),FBARRY("PATIENT INTERNAL"),FBARRY("PROCESS DATE INTERNAL"),FBARRY("LI NUMBER"))
 S:'+FBNIEN FBOK=-1
 S:FBOK'=-1 FBOK=$$UPDTONE(FBNIEN,FB5010TYP,FBIBIEN2,FBNPIFLG,FBTXYFLG,.FBARRY)  ;UPDATES FEE BASIS PAID WITH RESULTS FOR THIS PROVIDER
 Q FBOK
 ;
GETFBDUZ(FBBTCH) ;returns an IEN from NEW PERSON file
 ;INPUT FBBTCH : the internal number of the FEE BASIS BATCH that the invoice is part of
 ;
 ; OUTPUT : the IEN of the NEW PERSON file for SUPERVISOR WHO CERTIFIED this batch
 ;
 N FBDUZ
 ;
 S FBIENS=FBBTCH_","
 S FBDUZ=$$GET1^DIQ(161.7,FBBTCH_",",6,"I","","")   ;FEE BASIS BATCH FILE (#6) SUPERVISOR WHO CERTIFIED [7P:200]
 Q FBDUZ
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBPAID3A   14480     printed  Sep 23, 2025@19:35:30                                                                                                                                                                                                   Page 2
FBPAID3A  ;DSS/SCR - Utilities to support FEE BASIS PAID TO IB Process ;3/28/1012
 +1       ;;3.5;FEE BASIS;**135**;JAN 30, 1995;Build 3
 +2       ;;Per VHA Directive 2004-038, this routine should not be modified.
 +3       ;
 +4       ;; DBIA SUPPORTED REF CHKDGT^XUSNPI
 +5        QUIT 
 +6       ;
 +7       ;
PRCFBREC(FBIEN,FBRECARY,FBARRY,FBCHECK) ;Processes one Fee Basis record
 +1       ;                                       
 +2       ; INPUT : FBIEN - the IEN of the FEE BASIS TO IB file line being processed
 +3       ;         FBRECARY - AN array populated with information about the FEE BASIS INVOICE
 +4       ;         FBARRY - An array used to update the FEE BASIS PAID TO IB file
 +5       ;         FBCHECK - An array passed by reference which holds processed NPIs
 +6       ;  
 +7       ; OUTPUT: FBARRY populated with line item provider information
 +8       ;         FBCHECK populated with information about each NPI which has been processed
 +9       ;         'FBQUIT - 1 if no problems stopped processing, 0 if they did
 +10      ;
 +11       NEW FBDUZ,FBPRVTYP,FBVDRIEN,FBATDNAM,FBATDNPI,FBATDTXY,FBOPRNAM,FBOPRNPI,FBOPRTXY
 +12       NEW FBRNDNAM,FBRNDNPI,FBRNDTXY,FBSRVNAM,FBSRVNPI,FBSRVTXY,FBREFNAM,FBREFNPI,FBREFTXY
 +13       NEW FBLIRNAM,FBLIRNPI,FBLIRTXY
 +14       NEW FBINFO,FBIBIEN,FBNPIFLG,FBTXYFLG,FBOK,FBQUIT,FBNIEN,FBBADNPI
 +15      ;
 +16       SET FBQUIT=0
 +17      ;
 +18       SET FBDUZ=$$GETFBDUZ(FBRECARY("BATCH NUMBER"))
 +19      ;FIRST add the PRIMARY provider info
 +20      ;FIRST WE LOOK FOR/ADD A FACILITY PROVIDER IN THE IB FILE
           SET FBPRVTYP="1"
 +21       SET FBVDRIEN=FBRECARY("VENDOR INTERNAL")
 +22      ;if we don't have a valid VENDOR we won't be sending a bill out
           IF FBVDRIEN<0
               SET FBQUIT=1
 +23       IF 'FBQUIT
               Begin DoDot:1
 +24               SET FBATDNAM=FBRECARY("ATTENDING NAME")
 +25               SET FBOPRNAM=FBRECARY("OPERATING NAME")
 +26               SET FBRNDNAM=FBRECARY("RENDERING NAME")
 +27               SET FBSRVNAM=FBRECARY("SERVICING NAME")
 +28               SET FBREFNAM=FBRECARY("REFERRING NAME")
 +29               SET FBPRVNAM=""
 +30               SET FBPRVNPI=""
 +31               SET FBPRVTXY=""
 +32               SET FBINFO=$$FBTOIB(FBVDRIEN,FBPRVNAM,FBPRVTYP,FBPRVNPI,FBPRVTXY,FBDUZ,.FBCHECK)
 +33               SET FBIBIEN=$PIECE(FBINFO,U,1)
 +34               SET FBNPIFLG=$PIECE(FBINFO,U,2)
 +35               SET FBTXYFLG=$PIECE(FBINFO,U,3)
 +36      ;UPDATES FEE BASIS PAID WITH RESULTS FOR THIS PROVIDER
                   SET FBOK=$$UPDTONE(FBIEN,"V",FBIBIEN,FBNPIFLG,FBTXYFLG,.FBARRY)
 +37               if FBNPIFLG=0
                       QUIT 
 +38      ;ADD SERVICING PROVIDER INFORMATION AS A TYPE 1 PROVIDER
 +39               IF FBSRVNAM'=""
                       Begin DoDot:2
 +40                       NEW FBSRVINF,FBNIEN
 +41                       SET FBSRVNPI=$GET(FBRECARY("SERVICING NPI"))
 +42                       SET FBSRVTXY=$GET(FBRECARY("SERVICING TXY"))
 +43                       SET FBSRVTXY=""
 +44                       SET FBSRVINF("ADDRESS")=FBRECARY("SERVICING ADDRESS")
 +45                       SET FBSRVINF("CITY")=FBRECARY("SERVICING CITY")
 +46                       SET FBSRVINF("STATE")=FBRECARY("SERVICING STATE INT")
 +47                       SET FBSRVINF("ZIP")=FBRECARY("SERVICING ZIP")
 +48                       SET FBINFO=$$FBTOIB("",FBSRVNAM,FBPRVTYP,FBSRVNPI,FBSRVTXY,FBDUZ,.FBCHECK,.FBSRVINF)
 +49      ;THIS IS "" IF NO UPDATES WERE MADE, the IB record if it was found/updated
                           SET FBIBIEN=$PIECE(FBINFO,U,1)
 +50                       SET FBNPIFLG=$PIECE(FBINFO,U,2)
 +51                       SET FBTXYFLG=$PIECE(FBINFO,U,3)
 +52                       SET FBNIEN=$$ADD5010(FBARRY("PROGRAM INTERNAL"),FBARRY("FBICN"),FBARRY("PATIENT INTERNAL"),FBARRY("PROCESS DATE INTERNAL"),FBARRY("LI NUMBER"))
 +53                       if '+FBNIEN
                               QUIT 
 +54      ;UPDATES FEE BASIS PAID WITH RESULTS FOR THIS PROVIDER
                           SET FBOK=$$UPDTONE(FBNIEN,"S",FBIBIEN,FBNPIFLG,FBTXYFLG,.FBARRY)
                       End DoDot:2
 +55      ;MAKE A TYPE "2" PROVIDER ENTRY FOR EACH 5010 PROVIDER EXCEPT SERVICING
 +56      ;AN INDIVIDUAL TYPE PROVIDER IN THE IB NON/OTHER VA BILLING PROVIDER FILE
                   SET FBPRVTYP="2"
 +57               IF FBATDNAM'=""
                       Begin DoDot:2
 +58                       SET FBATDNPI=FBRECARY("ATTENDING NPI")
 +59                       SET FBATDTXY=FBRECARY("ATTENDING TXY")
 +60                       SET FBOK=$$TYPETWO("A",FBATDNAM,FBATDNPI,FBATDTXY,FBDUZ,.FBARRAY,.FBCHECK)
                       End DoDot:2
 +61               IF FBOPRNAM'=""
                       Begin DoDot:2
 +62                       SET FBOPRNPI=FBRECARY("OPERATING NPI")
 +63                       SET FBOPRTXY=""
 +64                       SET FBOK=$$TYPETWO("O",FBOPRNAM,FBOPRNPI,FBOPRTXY,FBDUZ,.FBARRAY,.FBCHECK)
                       End DoDot:2
 +65               IF FBRNDNAM'=""
                       Begin DoDot:2
 +66                       SET FBRNDNPI=FBRECARY("RENDERING NPI")
 +67                       SET FBRNDTXY=FBRECARY("RENDERING TXY")
 +68                       SET FBOK=$$TYPETWO("R",FBRNDNAM,FBRNDNPI,FBRNDTXY,FBDUZ,.FBARRAY,.FBCHECK)
                       End DoDot:2
 +69               IF FBREFNAM'=""
                       Begin DoDot:2
 +70                       SET FBREFNPI=FBRECARY("REFERRING NPI")
 +71                       SET FBREFTXY=""
 +72                       SET FBOK=$$TYPETWO("F",FBREFNAM,FBREFNPI,FBREFTXY,FBDUZ,.FBARRAY,.FBCHECK)
                       End DoDot:2
 +73               IF FBARRY("PROGRAM INTERNAL")=3
                       Begin DoDot:2
 +74      ;ADD LINE ITEM RENDERING PROVIDER FOR OUPATIENT
 +75                       SET FBLIRNAM=FBRECARY("LI RENDERING NAME")
 +76                       SET FBLIRNPI=FBRECARY("LI RENDERING NPI")
 +77                       SET FBLIRTXY=FBRECARY("LI RENDERING TXY")
 +78                       IF FBLIRNAM'=""
                               SET FBOK=$$TYPETWO("L",FBLIRNAM,FBLIRNPI,FBLIRTXY,FBDUZ,.FBARRAY,.FBCHECK)
                       End DoDot:2
 +79               IF FBARRY("PROGRAM INTERNAL")=9
                       Begin DoDot:2
 +80      ;ADD A LINE FOR EACH INPATIENT LINE ITEM RENDERING INFO
 +81                       SET FBLINUM=0
 +82                       FOR 
                               SET FBLINUM=$ORDER(FBRECARY("LIRENDER NAME",FBLINUM))
                               if FBLINUM=""
                                   QUIT 
                               Begin DoDot:3
 +83                               SET FBLIRNAM=$GET(FBRECARY("LIRENDER NAME",FBLINUM))
 +84                               SET FBLIRNPI=$GET(FBRECARY("LIRENDER NPI",FBLINUM))
 +85                               SET FBLIRTXY=$GET(FBRECARY("LIRENDER TXY",FBLINUM))
 +86                               SET FBARRY("LI NUMBER")=$GET(FBRECARY("LINE ITEM NUMBER",FBLINUM))
 +87                               SET FBOK=$$TYPETWO("L",FBLIRNAM,FBLIRNPI,FBLIRTXY,FBDUZ,.FBARRAY,.FBCHECK)
                               End DoDot:3
                       End DoDot:2
               End DoDot:1
 +88       QUIT 'FBQUIT
 +89      ;
UPDTONE(FBIEN,FBTYP,FBIBICN,FBNPIFLG,FBTXYFLG,FBARRY) ;UPDATES a record in 161.9
 +1       ;
 +2       ; INPUT FBIEN : IEN OF FEE BASIS PAID TO IB file being updated
 +3       ;       FBTYP: INTERNAL value of set of codes identifying provider type
 +4       ;       FBIBICN  : IEN OF IB NON/VA OTHER BILLING PROVIDER file that was added or looked up
 +5       ;
 +6       ;       FBNPIFLG : '0' FOR NO NPI DATA PROVIDED;
 +7       ;                  '1' FOR NPI DATA INVALID;
 +8       ;                  '2' FOR NPI MATCHED ACTIVE, NO UPDATES;
 +9       ;                  '3' FOR NPI MATCHED ACTIVE, IB UPDATED;
 +10      ;                  '4' FOR NPI MATCHED INACTIVE, NO UPDATES;
 +11      ;                  '5' FOR NPI NEW, IB RECORD CREATED;
 +12      ;
 +13      ;       FBTXYFLG : '0' FOR NO TXY UPDATES ATTEMPTED;
 +14      ;                  '1' FOR TXY CODE NOT FOUND IN 8932.1;
 +15      ;                  '2' FOR MATCHED PRIMARY,NO UPDATES;
 +16      ;                  '3' FOR MATCHED NON-PRIMARY, IB TXY UPDATES;
 +17      ;                  '4' FOR NEW, IB TXY ENTRY CREATED;
 +18      ;
 +19      ;       FBARRY : ARRAY populated with initial values from lookup
 +20      ;
 +21       NEW FBOK,FBERR
 +22      ;
 +23      ; INTERNAL CODE FOR PRIMARY
           SET FBARRY("PROVIDER TYPE")=FBTYP
 +24      ;CAN BE NULL
           SET FBARRY("IBICN")=$GET(FBIBICN)
 +25      ;
           SET FBARRY("NPI ADDED")=FBNPIFLG
 +26      ;
           SET FBARRY("TXY ADDED")=FBTXYFLG
 +27       SET FBOK=$$SETFB2IB^FBPAID3(FBIEN,.FBARRY)
 +28       QUIT FBOK
 +29      ;
FBTOIB(FBVDRIEN,FBPRVNAM,FBPRVTYP,FBPRVNPI,FBPRVTXY,FBDUZ,FBCHECK,FBSRVINF) ;
 +1       ; PROCESSES information about one FB PROVIDER
 +2       ;
 +3       ; INPUTS  :  FBVDRIEN  : AN IEN to FEE BASIS VENDOR FILE
 +4       ;            FBPRVNAM  : A STRING OF TEXT FROM FB FILES REPRESENTING THE PROVIDER NAME
 +5       ;            FBPRVTYP  : "1" FOR FACILITY TYPE PROVIDER ;  "2" FOR INDIVIDUAL
 +6       ;            FBPRVNPI  : A STRING OF TEXT FROM FB FILES REPRESENTING THE PROVIDER NPI
 +7       ;            FBPRVTXY  : A STRING OF TEXT FROM FB FILES REPRESENTING A SUPPORTING PROVIDER TAXONOMY CODE
 +8       ;            FBDUZ     ; FB USER DUZ WHO LAST UPDATED THE FB FILE INFO IS COMING FROM
 +9       ;            FBSRVINF  : AN ARRAY OF INFORMATION FOR A SERVICING PROVIDER (TYPE 1) 
 +10      ;                            WILL BE NULL UNLESS THIS IS BEING CALLED TO ADD A SERVICING PROVIDER
 +11      ;
 +12      ;            FBCHECK   ; AN ARRAY OF NPIs that have been previously examined for this date
 +13      ;
 +14      ; OUTPUT :    A three piece string with information about how attempted updates went
 +15      ;        :    FBCHECK will contain information about NPIs that are 'new' for this date
 +16      ;
 +17       NEW FBQUIT,FBRTRN,FBIBIEN,FBIENS,FBFLDS,FBFLGS,FBINDX,FBSCRN,FBIDNT,FBINFO,FBBADNPI,FBNEW,FBRETRN
 +18      ;
 +19      ;"1" OR "2" for IB FACILITY or IB INDIVIDUAL
           SET FBINFO("FBPRVTYP")=FBPRVTYP
 +20       SET FBQUIT=0
 +21       SET FBIBIEN=-1
 +22       IF FBPRVNAM=""
               Begin DoDot:1
 +23               IF '+FBVDRIEN
                       SET FBPRVTYP=-1
               End DoDot:1
 +24       IF FBPRVNAM'=""
               Begin DoDot:1
 +25               IF ($LENGTH($GET(FBPRVNAM))>30)
                       SET FBPRVNAM=$EXTRACT(FBPRVNAM,1,30)
 +26      ;
                   IF ($LENGTH($GET(FBPRVNAM))<3)
                       SET FBPRVTYP=-1
               End DoDot:1
 +27       SET FBINFO("FB SUP DUZ")=FBDUZ
 +28       SET FBINFO("NAME")=FBPRVNAM
 +29       IF (FBPRVTYP="1")
               Begin DoDot:1
 +30               IF FBVDRIEN'=""
                       Begin DoDot:2
 +31      ;LOOK UP THE PROVIDER IN THE FEE BASIS VENDOR FILE
 +32      ;(#.01) NAME [1F] ^ (#1) ID NUMBER [2F] ^ (#2) STREET ADDRESS[3F] ^(#2.5) STREET ADDRESS 2 [14F]
 +33      ;^ (#3) CITY [4F] ^ (#4) STATE [5P:5] ^ (#5) ZIP CODE [6F]^(#14) PHONE NUMBER [1F] ;(#41.01) NPI (#42) TAXONOMY CODE [3F]
 +34                       IF '+FBVDRIEN
                               SET FBPRVTYP=-1
                               QUIT 
 +35                       SET FBFLDS=".01;1;2;2.5;3;4;5;14;41.01;42"
 +36      ;161.2  ;FEE BASIS VENDOR
                           DO GETS^DIQ(161.2,FBVDRIEN_",",FBFLDS,"IE","FBRTRN","FBERR")
 +37                       IF $GET(FBERR("DIERR"))'=""
                               SET FBPRVTYP=-1
                               QUIT 
 +38                       SET FBINFO("NAME")=$GET(FBRTRN(161.2,FBVDRIEN_",",".01","I"))
 +39                       IF $LENGTH(FBINFO("NAME"))>30
                               SET FBINFO("NAME")=$EXTRACT(FBINFO("NAME"),1,30)
 +40                       SET FBPRVNAM=FBINFO("NAME")
 +41                       SET FBINFO("FBFACID")=$GET(FBRTRN(161.2,FBVDRIEN_",","1","I"))
 +42                       SET FBINFO("FBADD1")=$GET(FBRTRN(161.2,FBVDRIEN_",","2","I"))
 +43                       SET FBINFO("FBADD2")=$GET(FBRTRN(161.2,FBVDRIEN_",","2.5","I"))
 +44                       SET FBINFO("FBCITY")=$GET(FBRTRN(161.2,FBVDRIEN_",","3","I"))
 +45                       SET FBINFO("FBSTATE")=$GET(FBRTRN(161.2,FBVDRIEN_",","4","E"))
 +46      ;this is pointer to state file
                           SET FBINFO("FBSTATE INT")=$GET(FBRTRN(161.2,FBVDRIEN_",","4","I"))
 +47                       SET FBINFO("FBZIP")=$GET(FBRTRN(161.2,FBVDRIEN_",","5","I"))
 +48                       SET FBINFO("FBPHONE")=$GET(FBRTRN(161.2,FBVDRIEN_",","14","I"))
 +49                       SET FBINFO("FBNPI")=$GET(FBRTRN(161.2,FBVDRIEN_",","41.01","I"))
 +50                       SET FBINFO("FBTXY")=$GET(FBRTRN(161.2,FBVDRIEN_",","42","I"))
 +51                       SET FBINFO("IB TYPE")=1
                       End DoDot:2
 +52               IF FBVDRIEN=""
                       Begin DoDot:2
 +53      ;ADDING A SERVICING PROVIDER with address info from the FEE BASIS INVOICE or PAYMENT file
 +54                       SET FBINFO("FBADD1")=$GET(FBSRVINF("ADDRESS"))
 +55                       SET FBINFO("FBADD2")=""
 +56                       SET FBINFO("FBCITY")=$GET(FBSRVINF("CITY"))
 +57      ;this is pointer to state file
                           SET FBINFO("FBSTATE INT")=$GET(FBSRVINF("STATE"))
 +58                       SET FBINFO("FBZIP")=$GET(FBSRVINF("ZIP"))
 +59                       SET FBINFO("FBNPI")=$GET(FBPRVNPI)
 +60                       SET FBINFO("FBTXY")=$GET(FBPRVTXY)
 +61                       SET FBINFO("IB TYPE")=1
                       End DoDot:2
 +62               SET FBPRVNPI=FBINFO("FBNPI")
 +63               SET FBPRVTXY=FBINFO("FBTXY")
 +64      ;Check to see if NPI has been processed for this process date
 +65               IF $GET(FBPRVNPI)=""
                       SET FBPRVNPI=0
 +66               IF $GET(FBCHECK(FBPRVNPI))'=""
                       Begin DoDot:2
 +67      ;IBRECORD^NO UPDATES ATTEMPTED ^ NO TXY UPDATES ATTEMPTED
                           if $PIECE(FBCHECK(FBPRVNPI),U,2)'=1
                               SET FBNEW=$PIECE(FBCHECK(FBPRVNPI),U,1)_"^0^0"
 +68      ; "^1^0" ;NPI INVALID, no IB record
                           if $PIECE(FBCHECK(FBPRVNPI),U,2)'=1
                               SET FBNEW=FBCHECK(FBPRVNPI)
                       End DoDot:2
 +69               if $GET(FBNEW)'=""
                       QUIT 
 +70               SET FBBADNPI=0
 +71               if $GET(FBPRVNPI)=""
                       SET FBPRVNPI=0
 +72               if $GET(FBPRVNPI)=""
                       QUIT 
 +73               IF $LENGTH(FBPRVNPI)>10!($LENGTH(FBPRVNPI)<10)!('$$CHKDGT^XUSNPI(FBPRVNPI))
                       SET FBBADNPI=1
 +74               IF 'FBBADNPI
                       Begin DoDot:2
 +75      ;compares/updates 355.93 -- IB NON/OTHER VA BILLING PROVIDER FILE
                           DO EPFBAPI^IBCEP8C(.FBINFO,.FBRETRN)
 +76                       SET FBNEW=FBRETRN(1)_"^"_FBRETRN(2)_"^"_FBRETRN(3)
                       End DoDot:2
 +77               IF FBBADNPI
                       SET FBNEW="^1^0"
 +78               SET FBCHECK(FBPRVNPI)=FBNEW
               End DoDot:1
 +79       IF FBPRVTYP="2"
               Begin DoDot:1
 +80      ;NO LOOK UP TO FB FILES OCCURS- THIS IS NOT A BILLING PROVIDER AND WON'T BE IN THE FEE BASIS VENDOR FILE
 +81               SET FBINFO("NAME")=FBPRVNAM
 +82               SET FBINFO("FBNPI")=FBPRVNPI
 +83               SET FBINFO("FBTXY")=FBPRVTXY
 +84               SET FBINFO("IB TYPE")=2
 +85               IF $GET(FBPRVNPI)=""
                       SET FBPRVNPI=0
 +86               IF $GET(FBCHECK(FBPRVNPI))'=""
                       SET FBNEW=$GET(FBCHECK(FBPRVNPI))
 +87               IF $GET(FBNEW)=""
                       Begin DoDot:2
 +88                       SET FBBADNPI=0
 +89                       IF $LENGTH(FBPRVNPI)>10!($LENGTH(FBPRVNPI)<10)!('$$CHKDGT^XUSNPI(FBPRVNPI))
                               SET FBBADNPI=1
 +90                       IF 'FBBADNPI
                               Begin DoDot:3
 +91      ;compares/updates 355.93 -- IB NON/OTHER VA BILLING PROVIDER FILE
                                   DO EPFBAPI^IBCEP8C(.FBINFO,.FBRETRN)
 +92                               if FBRETRN(1)'=""
                                       SET FBNEW=FBRETRN(1)_"^"_FBRETRN(2)_"^"_FBRETRN(3)
 +93      ;problems adding or finding provider, so no other updates attempted
                                   if FBRETRN(1)=""
                                       SET FBNEW="^0^0"
                               End DoDot:3
 +94                       IF FBBADNPI
                               SET FBNEW="^1^0"
                       End DoDot:2
 +95               if FBBADNPI
                       QUIT 
               End DoDot:1
 +96      ;
           if FBPRVTYP=-1
               SET FBNEW="^0^0"
 +97      ;A THREE PIECE STRING OF INFORMATION ABOUT HOW UPDATES WENT
           QUIT FBNEW
 +98      ;
ADD5010(FBPROG,FBICN,FBPAT,FBDATE,FBLINUM) ;EP FROM FBPAID AND FBPAID3A
 +1       ; INPUT  : 
 +2       ;          FBPROG : "3" FOR OUTPATIENT, "9" FOR INPATIENT
 +3       ;          FBICN  : A FOUR PIECE ';' DELIMITED STRING
 +4       ;          FBPAT  : POINTER TO THE PATIENT FILE
 +5       ;          FBDATE : DATE OF MM MESSAGE FROM CENTRAL FEE PROCESSING
 +6       ;
 +7       ; OUPUT  : ien of new entry or -1 if problems occur
 +8       ;
 +9        NEW FBARRY,FBOK,FBERR
 +10      ;
 +11      ;INTERNAL
           SET FBARRY("PATIENT")=FBPAT
 +12       SET FBARRY("PROGRAM")=FBPROG
 +13       IF $GET(FBPROG)=3
               Begin DoDot:1
 +14               SET FBARRY("FBICN")=FBICN
 +15               SET FBARRY("LI NUMBER")=FBLINUM
               End DoDot:1
 +16       IF $GET(FBPROG)=9
               Begin DoDot:1
 +17               SET FBARRY("FBICN")=FBICN
               End DoDot:1
 +18      ;INTERNAL Date message started getting processed
           SET FBARRY("PROCESS DATE")=FBDATE
 +19      ;returns the ien of a new line, or -1
           SET FBOK=$$SETFB2IB^FBPAID3("",.FBARRY)
 +20       QUIT FBOK
 +21      ;
TYPETWO(FB5010TYP,FBPRVNAM,FBPRVNPI,FBPRVTXY,FBDUZ,FBARRAY,FBCHECK) ;process IB INDIVIDUAL providers
 +1       ; Validates NPI information for IB INDIVIDUAL (type 2) providers, and calls the IBAPI if the NPI is
 +2       ;    valid and has not already been processed for the current processing date.
 +3       ;
 +4       ; Updates the FEE BASIS PAID TO IB file with the results of validation/update
 +5       ;
 +6       ; INPUT  :   FB5010TYP ('A','O','R','S','F','L')
 +7       ;            FBPRVNAM   - The name of a type 2 provider
 +8       ;            FBPRVNPI  - The NPI of a type 2 provider
 +9       ;            FBPRVTXY  - Taxonomy code of a type 2 provider (can be null)
 +10      ;            FBDUZ      - IEN of supervisor who validated batch the fee basis record is in
 +11      ;            FBARRAY  - an array of information about the fee basis record being processed
 +12      ;            FBCHECK - an array of information about NPIs which have already been dealt with
 +13      ;
 +14      ;  OUTPUT : FBCHECK is updated with information about any NPI which is not already represented
 +15      ;           FBOK - IEN of record added or -1 if problems occurred
 +16      ;
 +17       NEW FBBADNPI,FBIBIEN2,FBNPIFLG,FBTXYFLG,FBNIEN,FBOK
 +18      ;
 +19       SET FBIBIEN2=""
 +20       SET FBBADNPI=0
 +21       SET FBOK=0
 +22       if $GET(FBPRVNPI)=""
               SET FBPRVNPI=0
 +23       IF $GET(FBCHECK(FBPRVNPI))'=""
               Begin DoDot:1
 +24      ;a record we found or added tonight or NULL
                   SET FBIBIEN2=$PIECE($GET(FBCHECK(FBPRVNPI)),U,1)
 +25      ;NO NPI UPDATES ATTEMPTED
                   if $PIECE($GET(FBCHECK(FBPRVNPI)),U,2)'=1
                       SET FBNPIFLG=0
 +26      ;NPI INVALID
                   if $PIECE($GET(FBCHECK(FBPRVNPI)),U,2)=1
                       SET FBNPIFLG=1
 +27      ; NO TXY UPDATES ATTEMPTED
                   SET FBTXYFLG=0
               End DoDot:1
 +28       IF $GET(FBCHECK(FBPRVNPI))=""
               Begin DoDot:1
 +29               IF $LENGTH(FBPRVNPI)>10!($LENGTH(FBPRVNPI)<10)!('$$CHKDGT^XUSNPI(FBPRVNPI))
                       SET FBBADNPI=1
 +30      ;INVALID NPI
                   IF FBBADNPI
                       SET FBCHECK(FBPRVNPI)="^1^0"
 +31               IF 'FBBADNPI
                       SET FBCHECK(FBPRVNPI)=$$FBTOIB("",FBPRVNAM,2,FBPRVNPI,FBPRVTXY,FBDUZ,.FBCHECK)
 +32               SET FBIBIEN2=$PIECE($GET(FBCHECK(FBPRVNPI)),U,1)
 +33               SET FBNPIFLG=$PIECE($GET(FBCHECK(FBPRVNPI)),U,2)
 +34               SET FBTXYFLG=$PIECE($GET(FBCHECK(FBPRVNPI)),U,3)
               End DoDot:1
 +35       SET FBNIEN=$$ADD5010(FBARRY("PROGRAM INTERNAL"),FBARRY("FBICN"),FBARRY("PATIENT INTERNAL"),FBARRY("PROCESS DATE INTERNAL"),FBARRY("LI NUMBER"))
 +36       if '+FBNIEN
               SET FBOK=-1
 +37      ;UPDATES FEE BASIS PAID WITH RESULTS FOR THIS PROVIDER
           if FBOK'=-1
               SET FBOK=$$UPDTONE(FBNIEN,FB5010TYP,FBIBIEN2,FBNPIFLG,FBTXYFLG,.FBARRY)
 +38       QUIT FBOK
 +39      ;
GETFBDUZ(FBBTCH) ;returns an IEN from NEW PERSON file
 +1       ;INPUT FBBTCH : the internal number of the FEE BASIS BATCH that the invoice is part of
 +2       ;
 +3       ; OUTPUT : the IEN of the NEW PERSON file for SUPERVISOR WHO CERTIFIED this batch
 +4       ;
 +5        NEW FBDUZ
 +6       ;
 +7        SET FBIENS=FBBTCH_","
 +8       ;FEE BASIS BATCH FILE (#6) SUPERVISOR WHO CERTIFIED [7P:200]
           SET FBDUZ=$$GET1^DIQ(161.7,FBBTCH_",",6,"I","","")
 +9        QUIT FBDUZ