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 Nov 22, 2024@17:09:36 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
