FBPAID3 ;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 INSUR^IBBAPI
; ELIG^VADPT
;
Q
;
IBALLWD() ;EP FROM FBPAID
; RETURNS 1 if lines should be added to the FEE BASIS PAID TO IB file for further processing
; by scheduled background job FB PAID TO IB
; 0 if the site has not set the site parameter to allow updates OR db errors occur
;
N FBIEN,FBRETRN,FBERR
;
S FBRETRN=0 ;DON'T ALLOW new entries to FEE BASIS PAID TO IB file...
S FBIEN=$O(^FBAA(161.4,0))
S:+FBIEN FBRETRN=$$GET1^DIQ(161.4,FBIEN_",",40,"I","","FBERR") ;if "" or 1 is returned updates ok
I $G(FBERR("DIERR"))'="" S FBRETRN=0
S:FBRETRN="" FBRETRN=0 ;Site must set parameter to make interface work initially
Q FBRETRN
;
;
ADDONE(FBPROG,FBIEN,FBPAT,FBDATE) ;EP FROM FBPAID
; INPUT : FBPROG : "3" FOR OUTPATIENT, "9" FOR INPATIENT
; FBIEN : AN ARRAY SET UP FROM THE PARSING ROUTINE IN FBPAID1
; 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")=$G(FBIEN(3))_";"_$G(FBIEN(2))_";"_$G(FBIEN(1))_";"_$G(FBIEN)
.S FBARRY("LI NUMBER")=FBIEN
I $G(FBPROG)=9 D
.S FBARRY("FBICN")=FBIEN
.;S FBARRY("LI NUMBER")=1 ;There can be up to 25 line items in the same record
S FBARRY("PROCESS DATE")=FBDATE ;INTERNAL Date message started getting processed
S FBOK=$$SETFB2IB("",.FBARRY) ;returns the ien of a new line, or -1
Q FBOK
;
EPFBTOIB(FBDATEIN) ;EP FROM FB PAID TO IB OPTION
; INPUT : FBDATEIN - OPTIONAL and not supplied by the OPTION if sent
; this should be 'DATE OF LAST GOOD RUN'
; - all dates after this date will be re-processed in the
; FEE BASIS PAID TO IB file
;
N FBIEN,FBTEST,FBQUIT,FBOK,FBIEN3,FBDATE,FBTODAY
S FBTODAY=DT
;
D CLEANUP(FBTODAY)
K ^TMP($J,"FBPAID3") ;temporary global to hold info for each date to be processed
;
I $G(FBDATEIN)="" D
.S FBQUIT=0
.S FBDATE=""
.S FBDATE=$O(^FB(161.9,"AC",FBDATE),-1)
.;FIND LAST PROCCESSED DATE BY LOOKING AT NPI ADDED field which is always populated when processed
.S:FBDATE="" FBQUIT=1
.F Q:FBQUIT D
..S FBIEN=0
..S FBIEN=$O(^FB(161.9,"AC",FBDATE,FBIEN))
..I $$GET1^DIQ(161.9,FBIEN_",",.08,"I","","")'="" S FBQUIT=1
..Q:FBQUIT
..S FBDATE=$O(^FB(161.9,"AC",FBDATE),-1)
..I FBDATE="" S FBQUIT=1
.S FBDATE=$O(^FB(161.9,"AC",FBDATE)) ;then I have found a date that has been processed, stepped back one and then quit...
I $G(FBDATEIN)'="" S FBDATE=FBDATEIN
Q:FBDATE="" ;NO UNPROCESSED RECORDS
F Q:(FBDATE="") D
.S FBIEN3=0
.F S FBIEN3=$O(^FB(161.9,"AC",FBDATE,FBIEN3)) Q:'+FBIEN3 S ^TMP($J,"FBPAID3",FBDATE,FBIEN3)=""
.D SCRUB2IB(FBDATE)
.K ^TMP($J,"FBPAID3",FBDATE)
.S FBDATE=$O(^FB(161.9,"AC",FBDATE))
Q
;
CLEANUP(FBDATE) ;delete entries from 161.9 older than 180 days from FBDATE
; INPUT : FBDATE - Today's date
;
;
N FBIEN,FBOLDATE
;
N X1,X2,X,%H,DA,DIK,DIE,DR
;
S X1=FBDATE
S X2=-179
D C^%DTC
S FBOLDATE=X ;THE FM DATE 179 DAYS BEFORE FBDATE
;
F S FBOLDATE=$O(^FB(161.9,"AC",FBOLDATE),-1) Q:FBOLDATE="" D
.S FBIEN=0
.F S FBIEN=$O(^FB(161.9,"AC",FBOLDATE,FBIEN)) Q:FBIEN="" D DELFB2IB(FBIEN)
Q
;
SCRUB2IB(FBDATE) ; process entries in 161.9 for this process date
;
; INPUT : FBDATE - Process date in FEE BASIS PAID TO IB file
;
; OUTUPT : 1 indication processing is complete
;
N FBIEN2,FBCHECK,FBPATARY,FBARRY,FBPAT,FBXIEN,FBNXT,FBRECARY,FBINSRET,FBTRTDT,FBDATE2,FBLINUM
;
; FBCHECK,FBARRY and FBRECARY are all arrays that keep persistent information
; through subroutine calls and are always passed by reference
;
S FBIEN2=0
;
S FBCHECK(0)="^0^0" ;the three piece string of info to use if NPI is blank
;
F S FBIEN2=$O(^TMP($J,"FBPAID3",FBDATE,FBIEN2)) Q:FBIEN2="" D
.S FBOK=$$GETFB2IB(FBIEN2,.FBARRY)
.S FBPAT=$G(FBARRY("PATIENT INTERNAL"))
.Q:'+FBPAT
.S:$G(FBPATARY(FBPAT,0))="" FBPATARY(FBPAT,0)='$$FBSC(FBPAT) ;(IF SC RETURNS 1, WE WANT 0)
.S FBPATARY(FBPAT,FBIEN2)=""
.Q:FBPATARY(FBPAT,0)=0
.S FBPROG=$G(FBARRY("PROGRAM INTERNAL"))
.S FBICN=$G(FBARRY("FBICN"))
.S FBLINUM=$G(FBARRY("LI NUMBER"))
.S FBOK=0 ;FLAGS IF DB CALLS RETURN WITH PROBLEMS
.I FBPROG=9 D
..S FBOK=$$GETFBINV(FBICN,.FBRECARY)
..Q:'FBOK
..S FBTRTDT=FBRECARY("TREATMENT FROM DATE")
..S:$G(FBPATARY(FBPAT,"STRTDT",FBTRTDT))="" FBPATARY(FBPAT,"STRTDT",FBTRTDT)=$$INSUR^IBBAPI(FBPAT,FBTRTDT,"I",.FBINSRET)
..S FBPATARY(FBPAT,FBIEN2)=FBPATARY(FBPAT,"STRTDT",FBTRTDT)
.;
.I FBPROG=3 D
..S FBOK=$$GETFBPAY(FBICN,.FBRECARY)
..Q:'FBOK
..S FBTRTDT=FBRECARY("TREATMENT DATE")
..S:$G(FBPATARY(FBPAT,"TRTDT",FBTRTDT))="" FBPATARY(FBPAT,"TRTDT",FBTRTDT)=$$INSUR^IBBAPI(FBPAT,FBTRTDT,"O",.FBINSRET)
..S FBPATARY(FBPAT,FBIEN2)=FBPATARY(FBPAT,"TRTDT",FBTRTDT)
.;
.Q:'FBOK
.I $G(FBRECARY("CONTRACT"))'="" S FBPATARY(FBPAT,FBIEN2)=-1 ;get rid of this record
.Q:$G(FBRECARY("CONTRACT"))'=""
.Q:FBPATARY(FBPAT,FBIEN2)=0 ;get rid of this record since no valid INPATIENT insurance on 'start date'
.I FBPATARY(FBPAT,FBIEN2)=1 D PRCFBREC^FBPAID3A(FBIEN2,.FBRECARY,.FBARRY,.FBCHECK)
;NOW REMOVE EACH RECORD EACH PATIENT THAT HAS SC STATUS from FEE BASIS PAID TO IB and from local array
S FBPAT=0
F S FBPAT=$O(FBPATARY(FBPAT)) Q:'+FBPAT D
.;IF THIS PERSON HAS SERVICE CONNECTED STATUS, KILL ALL HIS/HER ENTRIES
.I $G(FBPATARY(FBPAT,0))=0 D
..S FBXIEN=0
..F S FBXIEN=$O(FBPATARY(FBPAT,FBXIEN)) Q:'+FBXIEN D DELFB2IB(FBXIEN)
..K FBPATARY(FBPAT)
.;IF THIS PERSON DOES NOT HAVE APPROPRIATE COVERAGE ON THE DATE OF SERVICE, KILL THIS LINE
.I $G(FBPATARY(FBPAT,0))=1 D
..S FBXIEN=0
..F S FBXIEN=$O(FBPATARY(FBPAT,FBXIEN)) Q:'+FBXIEN D
...I $G(FBPATARY(FBPAT,FBXIEN))<=0 D
....D DELFB2IB(FBXIEN)
....K FBPATARY(FBPAT,FBXIEN)
.S FBXIEN=0
.;NOW KILL ANY REMAINING ENTRIES FOR THIS PATIENT THAT ARE FOR CONTRACTED SERVICES
.F S FBXIEN=$O(FBPATARY(FBPAT,FBXIEN)) Q:'+FBXIEN D
..I $G(FBPATARY(FBPAT,FBXIEN))<=0 D
...D DELFB2IB(FBXIEN)
...K FBPATARY(FBPAT,FBXIEN)
Q
;
SETFB2IB(FBIEN,FBARRY) ;ADD OR UPDATE A RECORD TO 161.9 FEE BASIS PAID TO IB FILE
;SETS FIELD VALUES INTO 161.9 -- FEE BASIS PAID TO IB FILE
;
; INPUT : FBIEN : IF "" a new entry will be created ELSE an EXISTING entry will be updated
; FBARRY - AN ARRAY OF INFORMATION IN INTERNAL FORMAT THAT WILL BE SET INTO THE NEW RECORD W/O VALIDATION
;
; FBERR - Empty array passed by reference which is populated if DB errors occur
;
N FBFDA,FBOK,FBIENRET,FBERR
;
S FBOK=1
I FBIEN="" D
.S FBFDA(161.9,"+1,",.01)=$G(FBARRY("PATIENT"))
.S FBFDA(161.9,"+1,",.02)=$G(FBARRY("PROGRAM"))
.S FBFDA(161.9,"+1,",.03)=$G(FBARRY("FBICN"))
.S FBFDA(161.9,"+1,",.04)=$G(FBARRY("PROCESS DATE"))
.S FBFDA(161.9,"+1,",.05)=$G(FBARRY("LI NUMBER"))
.D UPDATE^DIE("","FBFDA","FBIENRET","FBERR")
I FBIEN'="" D
.S FBFDA(161.9,FBIEN_",",.05)=$G(FBARRY("LI NUMBER"))
.S FBFDA(161.9,FBIEN_",",.06)=$G(FBARRY("PROVIDER TYPE"))
.S FBFDA(161.9,FBIEN_",",.07)=$G(FBARRY("IBICN"))
.S FBFDA(161.9,FBIEN_",",.08)=$G(FBARRY("NPI ADDED"))
.S FBFDA(161.9,FBIEN_",",.09)=$G(FBARRY("TXY ADDED"))
.D FILE^DIE("","FBFDA","FBERR")
;
I $G(FBERR("DIERR"))="" D
.S:$G(FBIENRET(1))'="" FBOK=FBIENRET(1) ;THE IEN WHICH WAS JUST ADDED
.S:$G(FBIENRET(1))="" FBOK=FBIEN
I $G(FBERR("DIERR"))'="" S FBOK=-1
Q FBOK ;RETURNS IEN JUST ADDED OR UPDATED OR -1
;
GETFB2IB(FBIEN,FBARRY) ;GETS FIELD VALUES FROM 161.9 FEE BASIS PAID TO IB FILE
;
; INPUT: FBIEN - THE IEN OF THE FEE BASIS PAID TO IB FILE INFORMAITON IS DESIRED FOR
; FBARRY - AN EMPTY ARRAY PASSED BY REFERENCE
;
; OUTPUT FBARRY : POPULATED WITH INFO ABOUT THIS IEN
;
N FBIENS,FBFLDS,FBRET,FBOK,FBERR
;
S FBOK=1
;
; FB INTERNAL CONTROL NUMBER [4F]
;^
;^ ^
;
D GETS^DIQ(161.9,FBIEN_",","*","EI","FBRET","FBERR")
I $G(FBERR("DIERR"))'="" S FBOK=-1
I $G(FBRET(161.9,FBIEN_",",".01","I"))="" S FBOK=0 ;NO SUCH RECORD IEN
;
I FBOK D
.S FBARRY("PATIENT")=$G(FBRET(161.9,FBIEN_",",".01","E"))
.S FBARRY("PATIENT INTERNAL")=$G(FBRET(161.9,FBIEN_",",".01","I")) ;(#.01) ENTRY ID [1N]
.S FBARRY("PROGRAM")=$G(FBRET(161.9,FBIEN_",",".02","E")) ;
.S FBARRY("PROGRAM INTERNAL")=$G(FBRET(161.9,FBIEN_",",".02","I")) ;(#.02) PATIENT [2P:2]
.S FBARRY("FBICN")=$G(FBRET(161.9,FBIEN_",",".03","E")) ;(#.03)PROGRAM [3S]
.S FBARRY("PROCESS DATE")=$G(FBRET(161.9,FBIEN_",",".04","E")) ;
.S FBARRY("PROCESS DATE INTERNAL")=$G(FBRET(161.9,FBIEN_",",".04","I")) ;(#.04)FB INTERNAL CONTROL NUMBER [4F]
.S FBARRY("LI NUMBER")=$G(FBRET(161.9,FBIEN_",",".05","E")) ;(#.05) PROCESS DATE [5D]
.S FBARRY("PROVIDER TYPE")=FBRET(161.9,FBIEN_",",".06","E") ;(#.06) PROVIDER TYPE [6S]
.S FBARRY("IBICN")=$G(FBRET(161.9,FBIEN_",",".07","E")) ;(#.07) IB NON/OTHER PNTR[7P]
.S FBARRY("NPI ADDED")=$G(FBRET(161.9,FBIEN_",",".08","E"))
.S FBARRY("NPI ADDED INTERNAL")=$G(FBRET(161.9,FBIEN_",",".08","I")) ;(#.08) NPI ADDED [8S]
.S FBARRY("TXY ADDED")=$G(FBRET(161.9,FBIEN_",",".09","E")) ;
.S FBARRY("TXY ADDED INTERNAL")=$G(FBRET(161.9,FBIEN_",",".09","I")) ;(#.09) TAXONOMY ADDED [9S]
;
I 'FBOK K FBARRY
;
Q FBOK
;
DELFB2IB(FBIEN) ;EP FROM FBPAID3A
;DELETES A RECORD FROM 161.9 FEE BASIS PAID TO IB FILE
;
; INPUT: FBIEN - The IEN of the FEE BASIS PAID TO IB FILE to be deleted
;
N DIK,DA
S DIK="^FB(161.9,"
S DA=FBIEN
D ^DIK
Q
;
FBSC(FBDFN) ; returns 1 if service connection indicated, 0 otherwise (based on VAEL(3))
; INPUT : FBDFN - ien to the PATIENT file
;
; OUTPUT : 1 if service connected, 0 if NO service connected
N FBX,VAEL,VAERR,DFN
S FBX=0
S DFN=FBDFN
I +$G(DFN) D ELIG^VADPT S FBX=$P($G(VAEL(3)),U,1)
Q FBX
;
GETFBINV(FBINVIEN,FBINVARY) ;Get info about a record in FEE BASIS INVOICE file
;
; INPUT :FBINVIEN the ien we wish to examine
; FBINVARY an empty array passed by reference
;
; OUTPUT : FBINVARY : populated with information about this record
;
N FBFLDS,FBQUIT,FBLIPRV,FBERR,FBFLDS2,FBRET,FBRET2
;
S FBQUIT=0
;
S FBFLDS=".01;2;5;6;20;60;64;65;66;67;68;69;70;71;72;73;74;75;80;81;82;83"
;(#2)VENDOR [3P:161.2] ;THIS IS OUR PRIMARY PROVIDER
;(#5) TREATMENT FROM DATE [6D] ^ (#6) TREATMENT TO DATE [7D]
;(#20) BATCH NUMBER ; (#60) CONTRACT [8P:161.43]
;(#64) ATTENDING PROV NAME [1F] ^ (#65) ATTENDING PROV NPI [2F](#66) ATTENDING PROV TAXONOMY CODE [3F] ^
;(#67) OPERATING PROV NAME [4F] ^ (#68) OPERATING PROV NPI [5F]
; (#69)RENDERING PROV NAME [6F] ^ (#70) RENDERING PROV NPI [7F] ^(#71) RENDERING PROV TAXONOMY CODE [8F]
;(#72) SERVICING PROVNAME [9F] ^ (#73) SERVICING PROV NPI [10F]
;(#74) REFERRING PROV NAME [11F] ^ (#75) REFERRING PROV NPI [12F];(#80) SERVICING FACILITY ADDRESS [1F]
;(#81) SERVICING FACILITY CITY [2F] ^ (#82) SERVICING FACILITY STATE [3P:5] ^ (#83) SERVICING FACILITY ZIP [4F]
D GETS^DIQ(162.5,FBINVIEN_",",FBFLDS,"I","FBRET","FBERR")
I $G(FBERR("DIERR"))'="" S FBQUIT=1
I 'FBQUIT D
.S FBINVARY("VENDOR INTERNAL")=$G(FBRET(162.5,FBINVIEN_",","2","I"))
.S FBINVARY("TREATMENT FROM DATE")=$G(FBRET(162.5,FBINVIEN_",","5","I"))
.S FBINVARY("TREATMENT TO DATE")=$G(FBRET(162.5,FBINVIEN_",","6","I"))
.S FBINVARY("BATCH NUMBER")=$G(FBRET(162.5,FBINVIEN_",","20","I"))
.S FBINVARY("CONTRACT")=$G(FBRET(162.5,FBINVIEN_",","60","I"))
.S FBINVARY("ATTENDING NAME")=$G(FBRET(162.5,FBINVIEN_",","64","I"))
.S FBINVARY("ATTENDING NPI")=$G(FBRET(162.5,FBINVIEN_",","65","I"))
.S FBINVARY("ATTENDING TXY")=$G(FBRET(162.5,FBINVIEN_",","66","I"))
.S FBINVARY("OPERATING NAME")=$G(FBRET(162.5,FBINVIEN_",","67","I"))
.S FBINVARY("OPERATING NPI")=$G(FBRET(162.5,FBINVIEN_",","68","I"))
.S FBINVARY("RENDERING NAME")=$G(FBRET(162.5,FBINVIEN_",","69","I"))
.S FBINVARY("RENDERING NPI")=$G(FBRET(162.5,FBINVIEN_",","70","I"))
.S FBINVARY("RENDERING TXY")=$G(FBRET(162.5,FBINVIEN_",","71","I"))
.S FBINVARY("SERVICING NAME")=$G(FBRET(162.5,FBINVIEN_",","72","I"))
.S FBINVARY("SERVICING NPI")=$G(FBRET(162.5,FBINVIEN_",","73","I"))
.S FBINVARY("REFERRING NAME")=$G(FBRET(162.5,FBINVIEN_",","74","I"))
.S FBINVARY("REFERRING NPI")=$G(FBRET(162.5,FBINVIEN_",","75","I"))
.S FBINVARY("SERVICING ADDRESS")=$G(FBRET(162.5,FBINVIEN_",","80","I"))
.S FBINVARY("SERVICING CITY")=$G(FBRET(162.5,FBINVIEN_",","81","I"))
.S FBINVARY("SERVICING STATE INT")=$G(FBRET(162.5,FBINVIEN_",","82","I"))
.S FBINVARY("SERVICING ZIP")=$G(FBRET(162.5,FBINVIEN_",","83","I"))
.;kill any existing LI info, because it may not get overwritten like the above
.K FBINVARY("LIRENDER NAME")
.K FBINVARY("LIRENDER NPI")
.K FBINVARY("LIRENDER TXY")
.;
.;NOW GET LI RENDERING PROVIDER INFO
.S FBLIPRV=0
.F S FBLIPRV=$O(^FBAAI(FBINVIEN,"RPROV",FBLIPRV)) Q:'+FBLIPRV D
..S FBFLDS2=".01;.02;.03;.04"
..;(#.01) LINE ITEM NUMBER [1N];(#.02) RENDERING PROV NAME [2F];(#.03) RENDERING PROV NPI [3F]
..; (#.04)RENDERING PROV TAXONOMY CODE [4F] ^
..D GETS^DIQ(162.579,FBLIPRV_","_FBINVIEN_",",FBFLDS2,"I","FBRET2","FBERR") ;162.579(#79) LINE ITEM RENDERING PROV
..I $G(FBERR("DIERR"))'="" S FBQUIT=1
..I 'FBQUIT D
...S FBINVARY("LINE ITEM NUMBER",FBLIPRV)=$G(FBRET2(162.579,FBLIPRV_","_FBINVIEN_",",".01","I"))
...S FBINVARY("LIRENDER NAME",FBLIPRV)=$G(FBRET2(162.579,FBLIPRV_","_FBINVIEN_",",".02","I"))
...S FBINVARY("LIRENDER NPI",FBLIPRV)=$G(FBRET2(162.579,FBLIPRV_","_FBINVIEN_",",".03","I"))
...S FBINVARY("LIRENDER TXY",FBLIPRV)=$G(FBRET2(162.579,FBLIPRV_","_FBINVIEN_",",".04","I"))
Q 'FBQUIT
;
GETFBPAY(FBPAYIEN,FBPAYARY) ;Get info about a record in FEE BASIS PAYMENT file
;
; INPUT :FBPAYIEN a four piece string that will identify the SERVICE
; FBPAYARY an empty array passed by reference
;
; OUTPUT : FBPAYARY : populated with information about this sub-record
; 0 if problems occurred, 1 otherwise
N FBIENS,FBFLDS,FBQUIT,FBRET,FBERR1
;
S FBQUIT=0
S FBIENS=$P(FBPAYIEN,";",2)_","_$P(FBPAYIEN,";",1)_"," ;THE PATIENT:VENDOR sub-record id
D GETS^DIQ(162.01,FBIENS,".01","I","FBRET","FBERR1") ;162.01 FEE BASIS PAYMENT FILE:(#.01) VENDOR subrecord
I $G(FBERR1("DIERR"))'="" S FBQUIT=1
I 'FBQUIT D
.S FBPAYARY("VENDOR INTERNAL")=$G(FBRET(162.01,FBIENS,".01","I"))
.;
.S FBIENS=$P(FBPAYIEN,";",3)_","_FBIENS
.D GETS^DIQ(162.02,FBIENS,".01","I","FBRET","FBERR1") ;162.02 (#.01) INITIAL TREATMENT DATE [1D]
.I $G(FBERR1("DIERR"))'="" S FBQUIT=1
.S FBPAYARY("TREATMENT DATE")=$G(FBRET(162.02,FBIENS,".01","I"))
.;
.I 'FBQUIT D
..S FBIENS=$P(FBPAYIEN,";",4)_","_FBIENS
..S FBFLDS="7;54;58;59;60;61;62;63;64;65;66;67;68;69;73;74;75;76;77;78;79"
..D GETS^DIQ(162.03,FBIENS,FBFLDS,"I","FBRET","FBERR1") ;162.03 ; (#2) SERVICE PROVIDED
..I $G(FBERR1("DIERR"))'="" S FBQUIT=1
..Q:FBQUIT
..S FBPAYARY("BATCH NUMBER")=$G(FBRET(162.03,FBIENS,"7","I"))
..S FBPAYARY("LI NUMBER")=$P(FBPAYIEN,";",4)
..S FBPAYARY("CONTRACT")=$G(FBRET(162.03,FBIENS,"54","I"))
..S FBPAYARY("ATTENDING NAME")=$G(FBRET(162.03,FBIENS,"58","I"))
..S FBPAYARY("ATTENDING NPI")=$G(FBRET(162.03,FBIENS,"59","I"))
..S FBPAYARY("ATTENDING TXY")=$G(FBRET(162.03,FBIENS,"60","I"))
..S FBPAYARY("OPERATING NAME")=$G(FBRET(162.03,FBIENS,"61","I"))
..S FBPAYARY("OPERATING NPI")=$G(FBRET(162.03,FBIENS,"62","I"))
..S FBPAYARY("RENDERING NAME")=$G(FBRET(162.03,FBIENS,"63","I"))
..S FBPAYARY("RENDERING NPI")=$G(FBRET(162.03,FBIENS,"64","I"))
..S FBPAYARY("RENDERING TXY")=$G(FBRET(162.03,FBIENS,"65","I"))
..S FBPAYARY("SERVICING NAME")=$G(FBRET(162.03,FBIENS,"66","I"))
..S FBPAYARY("SERVICING NPI")=$G(FBRET(162.03,FBIENS,"67","I"))
..S FBPAYARY("REFERRING NAME")=$G(FBRET(162.03,FBIENS,"68","I"))
..S FBPAYARY("REFERRING NPI")=$G(FBRET(162.03,FBIENS,"69","I"))
..S FBPAYARY("LI RENDERING NAME")=$G(FBRET(162.03,FBIENS,"73","I"))
..S FBPAYARY("LI RENDERING NPI")=$G(FBRET(162.03,FBIENS,"74","I"))
..S FBPAYARY("LI RENDERING TXY")=$G(FBRET(162.03,FBIENS,"75","I"))
..S FBPAYARY("SERVICING ADDRESS")=$G(FBRET(162.03,FBIENS,"76","I"))
..S FBPAYARY("SERVICING CITY")=$G(FBRET(162.03,FBIENS,"77","I"))
..S FBPAYARY("SERVICING STATE INT")=$G(FBRET(162.03,FBIENS,"78","I"))
..S FBPAYARY("SERVICING ZIP")=$G(FBRET(162.03,FBIENS,"79","I"))
Q 'FBQUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBPAID3 16758 printed Nov 22, 2024@17:09:35 Page 2
FBPAID3 ;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 INSUR^IBBAPI
+5 ; ELIG^VADPT
+6 ;
+7 QUIT
+8 ;
IBALLWD() ;EP FROM FBPAID
+1 ; RETURNS 1 if lines should be added to the FEE BASIS PAID TO IB file for further processing
+2 ; by scheduled background job FB PAID TO IB
+3 ; 0 if the site has not set the site parameter to allow updates OR db errors occur
+4 ;
+5 NEW FBIEN,FBRETRN,FBERR
+6 ;
+7 ;DON'T ALLOW new entries to FEE BASIS PAID TO IB file...
SET FBRETRN=0
+8 SET FBIEN=$ORDER(^FBAA(161.4,0))
+9 ;if "" or 1 is returned updates ok
if +FBIEN
SET FBRETRN=$$GET1^DIQ(161.4,FBIEN_",",40,"I","","FBERR")
+10 IF $GET(FBERR("DIERR"))'=""
SET FBRETRN=0
+11 ;Site must set parameter to make interface work initially
if FBRETRN=""
SET FBRETRN=0
+12 QUIT FBRETRN
+13 ;
+14 ;
ADDONE(FBPROG,FBIEN,FBPAT,FBDATE) ;EP FROM FBPAID
+1 ; INPUT : FBPROG : "3" FOR OUTPATIENT, "9" FOR INPATIENT
+2 ; FBIEN : AN ARRAY SET UP FROM THE PARSING ROUTINE IN FBPAID1
+3 ; FBPAT : POINTER TO THE PATIENT FILE
+4 ; FBDATE : DATE OF MM MESSAGE FROM CENTRAL FEE PROCESSING
+5 ;
+6 ; OUPUT : ien of new entry or -1 if problems occur
+7 ;
+8 NEW FBARRY,FBOK,FBERR
+9 ;
+10 ;INTERNAL
SET FBARRY("PATIENT")=FBPAT
+11 SET FBARRY("PROGRAM")=FBPROG
+12 IF $GET(FBPROG)=3
Begin DoDot:1
+13 SET FBARRY("FBICN")=$GET(FBIEN(3))_";"_$GET(FBIEN(2))_";"_$GET(FBIEN(1))_";"_$GET(FBIEN)
+14 SET FBARRY("LI NUMBER")=FBIEN
End DoDot:1
+15 IF $GET(FBPROG)=9
Begin DoDot:1
+16 SET FBARRY("FBICN")=FBIEN
+17 ;S FBARRY("LI NUMBER")=1 ;There can be up to 25 line items in the same record
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("",.FBARRY)
+20 QUIT FBOK
+21 ;
EPFBTOIB(FBDATEIN) ;EP FROM FB PAID TO IB OPTION
+1 ; INPUT : FBDATEIN - OPTIONAL and not supplied by the OPTION if sent
+2 ; this should be 'DATE OF LAST GOOD RUN'
+3 ; - all dates after this date will be re-processed in the
+4 ; FEE BASIS PAID TO IB file
+5 ;
+6 NEW FBIEN,FBTEST,FBQUIT,FBOK,FBIEN3,FBDATE,FBTODAY
+7 SET FBTODAY=DT
+8 ;
+9 DO CLEANUP(FBTODAY)
+10 ;temporary global to hold info for each date to be processed
KILL ^TMP($JOB,"FBPAID3")
+11 ;
+12 IF $GET(FBDATEIN)=""
Begin DoDot:1
+13 SET FBQUIT=0
+14 SET FBDATE=""
+15 SET FBDATE=$ORDER(^FB(161.9,"AC",FBDATE),-1)
+16 ;FIND LAST PROCCESSED DATE BY LOOKING AT NPI ADDED field which is always populated when processed
+17 if FBDATE=""
SET FBQUIT=1
+18 FOR
if FBQUIT
QUIT
Begin DoDot:2
+19 SET FBIEN=0
+20 SET FBIEN=$ORDER(^FB(161.9,"AC",FBDATE,FBIEN))
+21 IF $$GET1^DIQ(161.9,FBIEN_",",.08,"I","","")'=""
SET FBQUIT=1
+22 if FBQUIT
QUIT
+23 SET FBDATE=$ORDER(^FB(161.9,"AC",FBDATE),-1)
+24 IF FBDATE=""
SET FBQUIT=1
End DoDot:2
+25 ;then I have found a date that has been processed, stepped back one and then quit...
SET FBDATE=$ORDER(^FB(161.9,"AC",FBDATE))
End DoDot:1
+26 IF $GET(FBDATEIN)'=""
SET FBDATE=FBDATEIN
+27 ;NO UNPROCESSED RECORDS
if FBDATE=""
QUIT
+28 FOR
if (FBDATE="")
QUIT
Begin DoDot:1
+29 SET FBIEN3=0
+30 FOR
SET FBIEN3=$ORDER(^FB(161.9,"AC",FBDATE,FBIEN3))
if '+FBIEN3
QUIT
SET ^TMP($JOB,"FBPAID3",FBDATE,FBIEN3)=""
+31 DO SCRUB2IB(FBDATE)
+32 KILL ^TMP($JOB,"FBPAID3",FBDATE)
+33 SET FBDATE=$ORDER(^FB(161.9,"AC",FBDATE))
End DoDot:1
+34 QUIT
+35 ;
CLEANUP(FBDATE) ;delete entries from 161.9 older than 180 days from FBDATE
+1 ; INPUT : FBDATE - Today's date
+2 ;
+3 ;
+4 NEW FBIEN,FBOLDATE
+5 ;
+6 NEW X1,X2,X,%H,DA,DIK,DIE,DR
+7 ;
+8 SET X1=FBDATE
+9 SET X2=-179
+10 DO C^%DTC
+11 ;THE FM DATE 179 DAYS BEFORE FBDATE
SET FBOLDATE=X
+12 ;
+13 FOR
SET FBOLDATE=$ORDER(^FB(161.9,"AC",FBOLDATE),-1)
if FBOLDATE=""
QUIT
Begin DoDot:1
+14 SET FBIEN=0
+15 FOR
SET FBIEN=$ORDER(^FB(161.9,"AC",FBOLDATE,FBIEN))
if FBIEN=""
QUIT
DO DELFB2IB(FBIEN)
End DoDot:1
+16 QUIT
+17 ;
SCRUB2IB(FBDATE) ; process entries in 161.9 for this process date
+1 ;
+2 ; INPUT : FBDATE - Process date in FEE BASIS PAID TO IB file
+3 ;
+4 ; OUTUPT : 1 indication processing is complete
+5 ;
+6 NEW FBIEN2,FBCHECK,FBPATARY,FBARRY,FBPAT,FBXIEN,FBNXT,FBRECARY,FBINSRET,FBTRTDT,FBDATE2,FBLINUM
+7 ;
+8 ; FBCHECK,FBARRY and FBRECARY are all arrays that keep persistent information
+9 ; through subroutine calls and are always passed by reference
+10 ;
+11 SET FBIEN2=0
+12 ;
+13 ;the three piece string of info to use if NPI is blank
SET FBCHECK(0)="^0^0"
+14 ;
+15 FOR
SET FBIEN2=$ORDER(^TMP($JOB,"FBPAID3",FBDATE,FBIEN2))
if FBIEN2=""
QUIT
Begin DoDot:1
+16 SET FBOK=$$GETFB2IB(FBIEN2,.FBARRY)
+17 SET FBPAT=$GET(FBARRY("PATIENT INTERNAL"))
+18 if '+FBPAT
QUIT
+19 ;(IF SC RETURNS 1, WE WANT 0)
if $GET(FBPATARY(FBPAT,0))=""
SET FBPATARY(FBPAT,0)='$$FBSC(FBPAT)
+20 SET FBPATARY(FBPAT,FBIEN2)=""
+21 if FBPATARY(FBPAT,0)=0
QUIT
+22 SET FBPROG=$GET(FBARRY("PROGRAM INTERNAL"))
+23 SET FBICN=$GET(FBARRY("FBICN"))
+24 SET FBLINUM=$GET(FBARRY("LI NUMBER"))
+25 ;FLAGS IF DB CALLS RETURN WITH PROBLEMS
SET FBOK=0
+26 IF FBPROG=9
Begin DoDot:2
+27 SET FBOK=$$GETFBINV(FBICN,.FBRECARY)
+28 if 'FBOK
QUIT
+29 SET FBTRTDT=FBRECARY("TREATMENT FROM DATE")
+30 if $GET(FBPATARY(FBPAT,"STRTDT",FBTRTDT))=""
SET FBPATARY(FBPAT,"STRTDT",FBTRTDT)=$$INSUR^IBBAPI(FBPAT,FBTRTDT,"I",.FBINSRET)
+31 SET FBPATARY(FBPAT,FBIEN2)=FBPATARY(FBPAT,"STRTDT",FBTRTDT)
End DoDot:2
+32 ;
+33 IF FBPROG=3
Begin DoDot:2
+34 SET FBOK=$$GETFBPAY(FBICN,.FBRECARY)
+35 if 'FBOK
QUIT
+36 SET FBTRTDT=FBRECARY("TREATMENT DATE")
+37 if $GET(FBPATARY(FBPAT,"TRTDT",FBTRTDT))=""
SET FBPATARY(FBPAT,"TRTDT",FBTRTDT)=$$INSUR^IBBAPI(FBPAT,FBTRTDT,"O",.FBINSRET)
+38 SET FBPATARY(FBPAT,FBIEN2)=FBPATARY(FBPAT,"TRTDT",FBTRTDT)
End DoDot:2
+39 ;
+40 if 'FBOK
QUIT
+41 ;get rid of this record
IF $GET(FBRECARY("CONTRACT"))'=""
SET FBPATARY(FBPAT,FBIEN2)=-1
+42 if $GET(FBRECARY("CONTRACT"))'=""
QUIT
+43 ;get rid of this record since no valid INPATIENT insurance on 'start date'
if FBPATARY(FBPAT,FBIEN2)=0
QUIT
+44 IF FBPATARY(FBPAT,FBIEN2)=1
DO PRCFBREC^FBPAID3A(FBIEN2,.FBRECARY,.FBARRY,.FBCHECK)
End DoDot:1
+45 ;NOW REMOVE EACH RECORD EACH PATIENT THAT HAS SC STATUS from FEE BASIS PAID TO IB and from local array
+46 SET FBPAT=0
+47 FOR
SET FBPAT=$ORDER(FBPATARY(FBPAT))
if '+FBPAT
QUIT
Begin DoDot:1
+48 ;IF THIS PERSON HAS SERVICE CONNECTED STATUS, KILL ALL HIS/HER ENTRIES
+49 IF $GET(FBPATARY(FBPAT,0))=0
Begin DoDot:2
+50 SET FBXIEN=0
+51 FOR
SET FBXIEN=$ORDER(FBPATARY(FBPAT,FBXIEN))
if '+FBXIEN
QUIT
DO DELFB2IB(FBXIEN)
+52 KILL FBPATARY(FBPAT)
End DoDot:2
+53 ;IF THIS PERSON DOES NOT HAVE APPROPRIATE COVERAGE ON THE DATE OF SERVICE, KILL THIS LINE
+54 IF $GET(FBPATARY(FBPAT,0))=1
Begin DoDot:2
+55 SET FBXIEN=0
+56 FOR
SET FBXIEN=$ORDER(FBPATARY(FBPAT,FBXIEN))
if '+FBXIEN
QUIT
Begin DoDot:3
+57 IF $GET(FBPATARY(FBPAT,FBXIEN))<=0
Begin DoDot:4
+58 DO DELFB2IB(FBXIEN)
+59 KILL FBPATARY(FBPAT,FBXIEN)
End DoDot:4
End DoDot:3
End DoDot:2
+60 SET FBXIEN=0
+61 ;NOW KILL ANY REMAINING ENTRIES FOR THIS PATIENT THAT ARE FOR CONTRACTED SERVICES
+62 FOR
SET FBXIEN=$ORDER(FBPATARY(FBPAT,FBXIEN))
if '+FBXIEN
QUIT
Begin DoDot:2
+63 IF $GET(FBPATARY(FBPAT,FBXIEN))<=0
Begin DoDot:3
+64 DO DELFB2IB(FBXIEN)
+65 KILL FBPATARY(FBPAT,FBXIEN)
End DoDot:3
End DoDot:2
End DoDot:1
+66 QUIT
+67 ;
SETFB2IB(FBIEN,FBARRY) ;ADD OR UPDATE A RECORD TO 161.9 FEE BASIS PAID TO IB FILE
+1 ;SETS FIELD VALUES INTO 161.9 -- FEE BASIS PAID TO IB FILE
+2 ;
+3 ; INPUT : FBIEN : IF "" a new entry will be created ELSE an EXISTING entry will be updated
+4 ; FBARRY - AN ARRAY OF INFORMATION IN INTERNAL FORMAT THAT WILL BE SET INTO THE NEW RECORD W/O VALIDATION
+5 ;
+6 ; FBERR - Empty array passed by reference which is populated if DB errors occur
+7 ;
+8 NEW FBFDA,FBOK,FBIENRET,FBERR
+9 ;
+10 SET FBOK=1
+11 IF FBIEN=""
Begin DoDot:1
+12 SET FBFDA(161.9,"+1,",.01)=$GET(FBARRY("PATIENT"))
+13 SET FBFDA(161.9,"+1,",.02)=$GET(FBARRY("PROGRAM"))
+14 SET FBFDA(161.9,"+1,",.03)=$GET(FBARRY("FBICN"))
+15 SET FBFDA(161.9,"+1,",.04)=$GET(FBARRY("PROCESS DATE"))
+16 SET FBFDA(161.9,"+1,",.05)=$GET(FBARRY("LI NUMBER"))
+17 DO UPDATE^DIE("","FBFDA","FBIENRET","FBERR")
End DoDot:1
+18 IF FBIEN'=""
Begin DoDot:1
+19 SET FBFDA(161.9,FBIEN_",",.05)=$GET(FBARRY("LI NUMBER"))
+20 SET FBFDA(161.9,FBIEN_",",.06)=$GET(FBARRY("PROVIDER TYPE"))
+21 SET FBFDA(161.9,FBIEN_",",.07)=$GET(FBARRY("IBICN"))
+22 SET FBFDA(161.9,FBIEN_",",.08)=$GET(FBARRY("NPI ADDED"))
+23 SET FBFDA(161.9,FBIEN_",",.09)=$GET(FBARRY("TXY ADDED"))
+24 DO FILE^DIE("","FBFDA","FBERR")
End DoDot:1
+25 ;
+26 IF $GET(FBERR("DIERR"))=""
Begin DoDot:1
+27 ;THE IEN WHICH WAS JUST ADDED
if $GET(FBIENRET(1))'=""
SET FBOK=FBIENRET(1)
+28 if $GET(FBIENRET(1))=""
SET FBOK=FBIEN
End DoDot:1
+29 IF $GET(FBERR("DIERR"))'=""
SET FBOK=-1
+30 ;RETURNS IEN JUST ADDED OR UPDATED OR -1
QUIT FBOK
+31 ;
GETFB2IB(FBIEN,FBARRY) ;GETS FIELD VALUES FROM 161.9 FEE BASIS PAID TO IB FILE
+1 ;
+2 ; INPUT: FBIEN - THE IEN OF THE FEE BASIS PAID TO IB FILE INFORMAITON IS DESIRED FOR
+3 ; FBARRY - AN EMPTY ARRAY PASSED BY REFERENCE
+4 ;
+5 ; OUTPUT FBARRY : POPULATED WITH INFO ABOUT THIS IEN
+6 ;
+7 NEW FBIENS,FBFLDS,FBRET,FBOK,FBERR
+8 ;
+9 SET FBOK=1
+10 ;
+11 ; FB INTERNAL CONTROL NUMBER [4F]
+12 ;^
+13 ;^ ^
+14 ;
+15 DO GETS^DIQ(161.9,FBIEN_",","*","EI","FBRET","FBERR")
+16 IF $GET(FBERR("DIERR"))'=""
SET FBOK=-1
+17 ;NO SUCH RECORD IEN
IF $GET(FBRET(161.9,FBIEN_",",".01","I"))=""
SET FBOK=0
+18 ;
+19 IF FBOK
Begin DoDot:1
+20 SET FBARRY("PATIENT")=$GET(FBRET(161.9,FBIEN_",",".01","E"))
+21 ;(#.01) ENTRY ID [1N]
SET FBARRY("PATIENT INTERNAL")=$GET(FBRET(161.9,FBIEN_",",".01","I"))
+22 ;
SET FBARRY("PROGRAM")=$GET(FBRET(161.9,FBIEN_",",".02","E"))
+23 ;(#.02) PATIENT [2P:2]
SET FBARRY("PROGRAM INTERNAL")=$GET(FBRET(161.9,FBIEN_",",".02","I"))
+24 ;(#.03)PROGRAM [3S]
SET FBARRY("FBICN")=$GET(FBRET(161.9,FBIEN_",",".03","E"))
+25 ;
SET FBARRY("PROCESS DATE")=$GET(FBRET(161.9,FBIEN_",",".04","E"))
+26 ;(#.04)FB INTERNAL CONTROL NUMBER [4F]
SET FBARRY("PROCESS DATE INTERNAL")=$GET(FBRET(161.9,FBIEN_",",".04","I"))
+27 ;(#.05) PROCESS DATE [5D]
SET FBARRY("LI NUMBER")=$GET(FBRET(161.9,FBIEN_",",".05","E"))
+28 ;(#.06) PROVIDER TYPE [6S]
SET FBARRY("PROVIDER TYPE")=FBRET(161.9,FBIEN_",",".06","E")
+29 ;(#.07) IB NON/OTHER PNTR[7P]
SET FBARRY("IBICN")=$GET(FBRET(161.9,FBIEN_",",".07","E"))
+30 SET FBARRY("NPI ADDED")=$GET(FBRET(161.9,FBIEN_",",".08","E"))
+31 ;(#.08) NPI ADDED [8S]
SET FBARRY("NPI ADDED INTERNAL")=$GET(FBRET(161.9,FBIEN_",",".08","I"))
+32 ;
SET FBARRY("TXY ADDED")=$GET(FBRET(161.9,FBIEN_",",".09","E"))
+33 ;(#.09) TAXONOMY ADDED [9S]
SET FBARRY("TXY ADDED INTERNAL")=$GET(FBRET(161.9,FBIEN_",",".09","I"))
End DoDot:1
+34 ;
+35 IF 'FBOK
KILL FBARRY
+36 ;
+37 QUIT FBOK
+38 ;
DELFB2IB(FBIEN) ;EP FROM FBPAID3A
+1 ;DELETES A RECORD FROM 161.9 FEE BASIS PAID TO IB FILE
+2 ;
+3 ; INPUT: FBIEN - The IEN of the FEE BASIS PAID TO IB FILE to be deleted
+4 ;
+5 NEW DIK,DA
+6 SET DIK="^FB(161.9,"
+7 SET DA=FBIEN
+8 DO ^DIK
+9 QUIT
+10 ;
FBSC(FBDFN) ; returns 1 if service connection indicated, 0 otherwise (based on VAEL(3))
+1 ; INPUT : FBDFN - ien to the PATIENT file
+2 ;
+3 ; OUTPUT : 1 if service connected, 0 if NO service connected
+4 NEW FBX,VAEL,VAERR,DFN
+5 SET FBX=0
+6 SET DFN=FBDFN
+7 IF +$GET(DFN)
DO ELIG^VADPT
SET FBX=$PIECE($GET(VAEL(3)),U,1)
+8 QUIT FBX
+9 ;
GETFBINV(FBINVIEN,FBINVARY) ;Get info about a record in FEE BASIS INVOICE file
+1 ;
+2 ; INPUT :FBINVIEN the ien we wish to examine
+3 ; FBINVARY an empty array passed by reference
+4 ;
+5 ; OUTPUT : FBINVARY : populated with information about this record
+6 ;
+7 NEW FBFLDS,FBQUIT,FBLIPRV,FBERR,FBFLDS2,FBRET,FBRET2
+8 ;
+9 SET FBQUIT=0
+10 ;
+11 SET FBFLDS=".01;2;5;6;20;60;64;65;66;67;68;69;70;71;72;73;74;75;80;81;82;83"
+12 ;(#2)VENDOR [3P:161.2] ;THIS IS OUR PRIMARY PROVIDER
+13 ;(#5) TREATMENT FROM DATE [6D] ^ (#6) TREATMENT TO DATE [7D]
+14 ;(#20) BATCH NUMBER ; (#60) CONTRACT [8P:161.43]
+15 ;(#64) ATTENDING PROV NAME [1F] ^ (#65) ATTENDING PROV NPI [2F](#66) ATTENDING PROV TAXONOMY CODE [3F] ^
+16 ;(#67) OPERATING PROV NAME [4F] ^ (#68) OPERATING PROV NPI [5F]
+17 ; (#69)RENDERING PROV NAME [6F] ^ (#70) RENDERING PROV NPI [7F] ^(#71) RENDERING PROV TAXONOMY CODE [8F]
+18 ;(#72) SERVICING PROVNAME [9F] ^ (#73) SERVICING PROV NPI [10F]
+19 ;(#74) REFERRING PROV NAME [11F] ^ (#75) REFERRING PROV NPI [12F];(#80) SERVICING FACILITY ADDRESS [1F]
+20 ;(#81) SERVICING FACILITY CITY [2F] ^ (#82) SERVICING FACILITY STATE [3P:5] ^ (#83) SERVICING FACILITY ZIP [4F]
+21 DO GETS^DIQ(162.5,FBINVIEN_",",FBFLDS,"I","FBRET","FBERR")
+22 IF $GET(FBERR("DIERR"))'=""
SET FBQUIT=1
+23 IF 'FBQUIT
Begin DoDot:1
+24 SET FBINVARY("VENDOR INTERNAL")=$GET(FBRET(162.5,FBINVIEN_",","2","I"))
+25 SET FBINVARY("TREATMENT FROM DATE")=$GET(FBRET(162.5,FBINVIEN_",","5","I"))
+26 SET FBINVARY("TREATMENT TO DATE")=$GET(FBRET(162.5,FBINVIEN_",","6","I"))
+27 SET FBINVARY("BATCH NUMBER")=$GET(FBRET(162.5,FBINVIEN_",","20","I"))
+28 SET FBINVARY("CONTRACT")=$GET(FBRET(162.5,FBINVIEN_",","60","I"))
+29 SET FBINVARY("ATTENDING NAME")=$GET(FBRET(162.5,FBINVIEN_",","64","I"))
+30 SET FBINVARY("ATTENDING NPI")=$GET(FBRET(162.5,FBINVIEN_",","65","I"))
+31 SET FBINVARY("ATTENDING TXY")=$GET(FBRET(162.5,FBINVIEN_",","66","I"))
+32 SET FBINVARY("OPERATING NAME")=$GET(FBRET(162.5,FBINVIEN_",","67","I"))
+33 SET FBINVARY("OPERATING NPI")=$GET(FBRET(162.5,FBINVIEN_",","68","I"))
+34 SET FBINVARY("RENDERING NAME")=$GET(FBRET(162.5,FBINVIEN_",","69","I"))
+35 SET FBINVARY("RENDERING NPI")=$GET(FBRET(162.5,FBINVIEN_",","70","I"))
+36 SET FBINVARY("RENDERING TXY")=$GET(FBRET(162.5,FBINVIEN_",","71","I"))
+37 SET FBINVARY("SERVICING NAME")=$GET(FBRET(162.5,FBINVIEN_",","72","I"))
+38 SET FBINVARY("SERVICING NPI")=$GET(FBRET(162.5,FBINVIEN_",","73","I"))
+39 SET FBINVARY("REFERRING NAME")=$GET(FBRET(162.5,FBINVIEN_",","74","I"))
+40 SET FBINVARY("REFERRING NPI")=$GET(FBRET(162.5,FBINVIEN_",","75","I"))
+41 SET FBINVARY("SERVICING ADDRESS")=$GET(FBRET(162.5,FBINVIEN_",","80","I"))
+42 SET FBINVARY("SERVICING CITY")=$GET(FBRET(162.5,FBINVIEN_",","81","I"))
+43 SET FBINVARY("SERVICING STATE INT")=$GET(FBRET(162.5,FBINVIEN_",","82","I"))
+44 SET FBINVARY("SERVICING ZIP")=$GET(FBRET(162.5,FBINVIEN_",","83","I"))
+45 ;kill any existing LI info, because it may not get overwritten like the above
+46 KILL FBINVARY("LIRENDER NAME")
+47 KILL FBINVARY("LIRENDER NPI")
+48 KILL FBINVARY("LIRENDER TXY")
+49 ;
+50 ;NOW GET LI RENDERING PROVIDER INFO
+51 SET FBLIPRV=0
+52 FOR
SET FBLIPRV=$ORDER(^FBAAI(FBINVIEN,"RPROV",FBLIPRV))
if '+FBLIPRV
QUIT
Begin DoDot:2
+53 SET FBFLDS2=".01;.02;.03;.04"
+54 ;(#.01) LINE ITEM NUMBER [1N];(#.02) RENDERING PROV NAME [2F];(#.03) RENDERING PROV NPI [3F]
+55 ; (#.04)RENDERING PROV TAXONOMY CODE [4F] ^
+56 ;162.579(#79) LINE ITEM RENDERING PROV
DO GETS^DIQ(162.579,FBLIPRV_","_FBINVIEN_",",FBFLDS2,"I","FBRET2","FBERR")
+57 IF $GET(FBERR("DIERR"))'=""
SET FBQUIT=1
+58 IF 'FBQUIT
Begin DoDot:3
+59 SET FBINVARY("LINE ITEM NUMBER",FBLIPRV)=$GET(FBRET2(162.579,FBLIPRV_","_FBINVIEN_",",".01","I"))
+60 SET FBINVARY("LIRENDER NAME",FBLIPRV)=$GET(FBRET2(162.579,FBLIPRV_","_FBINVIEN_",",".02","I"))
+61 SET FBINVARY("LIRENDER NPI",FBLIPRV)=$GET(FBRET2(162.579,FBLIPRV_","_FBINVIEN_",",".03","I"))
+62 SET FBINVARY("LIRENDER TXY",FBLIPRV)=$GET(FBRET2(162.579,FBLIPRV_","_FBINVIEN_",",".04","I"))
End DoDot:3
End DoDot:2
End DoDot:1
+63 QUIT 'FBQUIT
+64 ;
GETFBPAY(FBPAYIEN,FBPAYARY) ;Get info about a record in FEE BASIS PAYMENT file
+1 ;
+2 ; INPUT :FBPAYIEN a four piece string that will identify the SERVICE
+3 ; FBPAYARY an empty array passed by reference
+4 ;
+5 ; OUTPUT : FBPAYARY : populated with information about this sub-record
+6 ; 0 if problems occurred, 1 otherwise
+7 NEW FBIENS,FBFLDS,FBQUIT,FBRET,FBERR1
+8 ;
+9 SET FBQUIT=0
+10 ;THE PATIENT:VENDOR sub-record id
SET FBIENS=$PIECE(FBPAYIEN,";",2)_","_$PIECE(FBPAYIEN,";",1)_","
+11 ;162.01 FEE BASIS PAYMENT FILE:(#.01) VENDOR subrecord
DO GETS^DIQ(162.01,FBIENS,".01","I","FBRET","FBERR1")
+12 IF $GET(FBERR1("DIERR"))'=""
SET FBQUIT=1
+13 IF 'FBQUIT
Begin DoDot:1
+14 SET FBPAYARY("VENDOR INTERNAL")=$GET(FBRET(162.01,FBIENS,".01","I"))
+15 ;
+16 SET FBIENS=$PIECE(FBPAYIEN,";",3)_","_FBIENS
+17 ;162.02 (#.01) INITIAL TREATMENT DATE [1D]
DO GETS^DIQ(162.02,FBIENS,".01","I","FBRET","FBERR1")
+18 IF $GET(FBERR1("DIERR"))'=""
SET FBQUIT=1
+19 SET FBPAYARY("TREATMENT DATE")=$GET(FBRET(162.02,FBIENS,".01","I"))
+20 ;
+21 IF 'FBQUIT
Begin DoDot:2
+22 SET FBIENS=$PIECE(FBPAYIEN,";",4)_","_FBIENS
+23 SET FBFLDS="7;54;58;59;60;61;62;63;64;65;66;67;68;69;73;74;75;76;77;78;79"
+24 ;162.03 ; (#2) SERVICE PROVIDED
DO GETS^DIQ(162.03,FBIENS,FBFLDS,"I","FBRET","FBERR1")
+25 IF $GET(FBERR1("DIERR"))'=""
SET FBQUIT=1
+26 if FBQUIT
QUIT
+27 SET FBPAYARY("BATCH NUMBER")=$GET(FBRET(162.03,FBIENS,"7","I"))
+28 SET FBPAYARY("LI NUMBER")=$PIECE(FBPAYIEN,";",4)
+29 SET FBPAYARY("CONTRACT")=$GET(FBRET(162.03,FBIENS,"54","I"))
+30 SET FBPAYARY("ATTENDING NAME")=$GET(FBRET(162.03,FBIENS,"58","I"))
+31 SET FBPAYARY("ATTENDING NPI")=$GET(FBRET(162.03,FBIENS,"59","I"))
+32 SET FBPAYARY("ATTENDING TXY")=$GET(FBRET(162.03,FBIENS,"60","I"))
+33 SET FBPAYARY("OPERATING NAME")=$GET(FBRET(162.03,FBIENS,"61","I"))
+34 SET FBPAYARY("OPERATING NPI")=$GET(FBRET(162.03,FBIENS,"62","I"))
+35 SET FBPAYARY("RENDERING NAME")=$GET(FBRET(162.03,FBIENS,"63","I"))
+36 SET FBPAYARY("RENDERING NPI")=$GET(FBRET(162.03,FBIENS,"64","I"))
+37 SET FBPAYARY("RENDERING TXY")=$GET(FBRET(162.03,FBIENS,"65","I"))
+38 SET FBPAYARY("SERVICING NAME")=$GET(FBRET(162.03,FBIENS,"66","I"))
+39 SET FBPAYARY("SERVICING NPI")=$GET(FBRET(162.03,FBIENS,"67","I"))
+40 SET FBPAYARY("REFERRING NAME")=$GET(FBRET(162.03,FBIENS,"68","I"))
+41 SET FBPAYARY("REFERRING NPI")=$GET(FBRET(162.03,FBIENS,"69","I"))
+42 SET FBPAYARY("LI RENDERING NAME")=$GET(FBRET(162.03,FBIENS,"73","I"))
+43 SET FBPAYARY("LI RENDERING NPI")=$GET(FBRET(162.03,FBIENS,"74","I"))
+44 SET FBPAYARY("LI RENDERING TXY")=$GET(FBRET(162.03,FBIENS,"75","I"))
+45 SET FBPAYARY("SERVICING ADDRESS")=$GET(FBRET(162.03,FBIENS,"76","I"))
+46 SET FBPAYARY("SERVICING CITY")=$GET(FBRET(162.03,FBIENS,"77","I"))
+47 SET FBPAYARY("SERVICING STATE INT")=$GET(FBRET(162.03,FBIENS,"78","I"))
+48 SET FBPAYARY("SERVICING ZIP")=$GET(FBRET(162.03,FBIENS,"79","I"))
End DoDot:2
End DoDot:1
+49 QUIT 'FBQUIT
