- 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 Feb 18, 2025@23:25:50 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