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

FBPAID3.m

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