IBCRHBR3 ;ALB/ARH - RATES: UPLOAD HOST FILES (RC) PARSE ; 10-OCT-1998
;;2.0;INTEGRATED BILLING;**106,138,148,169**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
; IBFLINE required and VERS expected on entry
;
A ; Inpatient Facility DRG Charges: process a single line, parse out into individual fields and store in XTMP
N IBDRG,IBSNS,IBDESC,IBRB,IBANC,IBBEG,IBEND,LINE,IBXIFN,IBXTMP S IBXTMP="IBCR RC A"
;
S IBDRG=$$P(IBFLINE,1),IBDRG=$$STRIP(IBDRG) Q:IBDRG'?3N ; DRG
S IBDESC=$$P(IBFLINE,2) ; description
S IBSNS=$$P(IBFLINE,3),IBSNS=$$STRIP(IBSNS) ; surgery/non-surgery
S IBRB=$$P(IBFLINE,4),IBRB=$$STRIP(IBRB) ; room & board
S IBANC=$$P(IBFLINE,5),IBANC=$$STRIP(IBANC) ; ancillary
S IBBEG=$$P(IBFLINE,6),IBBEG=$$STRIP(IBBEG) ; start date
S IBEND=$$P(IBFLINE,7),IBEND=$$STRIP(IBEND) ; end date
;
S LINE=IBDRG_U_IBSNS_U_IBRB_U_IBANC_U_IBBEG_U_IBEND S IBXIFN=$$SET(IBFILE,IBXTMP,LINE)
;
Q
;
B ; Inpatient Facility Area Factors: process a single line, parse out into individual fields and store in XTMP
N IBSITE,IBNAME,IBSRB,IBSAN,IBNRB,IBNAN,IBSNF,IBBEG,IBEND,LINE,IBXIFN,IBXTMP S IBXTMP="IBCR RC B"
;
S IBSITE=$$P(IBFLINE,1),IBSITE=$$STRIP(IBSITE) Q:IBSITE'?3N.UN ; site
S IBNAME=$$P(IBFLINE,2) ; facility name
S IBSRB=$$P(IBFLINE,3),IBSRB=$$STRIP(IBSRB) ; surgical room&board
S IBSAN=$$P(IBFLINE,4),IBSAN=$$STRIP(IBSAN) ; surgical ancillary
S IBNRB=$$P(IBFLINE,5),IBNRB=$$STRIP(IBNRB) ; non-surgical room&board
S IBNAN=$$P(IBFLINE,6),IBNAN=$$STRIP(IBNAN) ; non-surgical ancillary
S IBSNF=$$P(IBFLINE,7),IBSNF=$$STRIP(IBSNF) ; skilled nursing
S IBBEG=$$P(IBFLINE,8),IBBEG=$$STRIP(IBBEG) ; start date
S IBEND=$$P(IBFLINE,9),IBEND=$$STRIP(IBEND) ; end date
;
S LINE=IBSITE_U_IBSRB_U_IBSAN_U_IBNRB_U_IBNAN_U_IBSNF_U_IBBEG_U_IBEND
S IBXIFN=$$SET(IBFILE,IBXTMP,LINE) D SETSITE(IBXTMP,IBXIFN,IBSITE,IBNAME)
;
Q
;
C ; Outpatient Facility CPT Charges: process a single line, parse out into individual fields and store in XTMP
N IBCPT,IBCHG,IBBEG,IBEND,IBLMT,LINE,IBXIFN,IBXTMP S IBXTMP="IBCR RC C"
;
S IBCPT=$$P(IBFLINE,1),IBCPT=$$STRIP(IBCPT) I IBCPT'?5NU Q ; CPT
S IBCHG=$$P(IBFLINE,2),IBCHG=$$STRIP(IBCHG) ; charge
S IBBEG=$$P(IBFLINE,3),IBBEG=$$STRIP(IBBEG) ; start date
S IBEND=$$P(IBFLINE,4),IBEND=$$STRIP(IBEND) ; end date
S IBLMT=$$P(IBFLINE,5),IBLMT=$$STRIP(IBLMT) ; site limited flag
;
S LINE=IBCPT_U_IBCHG_U_IBBEG_U_IBEND_U_IBLMT S IBXIFN=$$SET(IBFILE,IBXTMP,LINE)
;
Q
;
D ; Outpatient Facility Area Factors: process a single line, parse out into individual fields and store in XTMP
N IBSITE,IBNAME,IBAF,IBBEG,IBEND,IBZIP,IBLMT,LINE,IBXIFN,IBXTMP S IBXTMP="IBCR RC D"
;
S IBSITE=$$P(IBFLINE,1),IBSITE=$$STRIP(IBSITE) Q:IBSITE'?3N.UN ; site
S IBNAME=$$P(IBFLINE,2) ; facility name
S IBAF=$$P(IBFLINE,3),IBAF=$$STRIP(IBAF) ; area factor
S IBBEG=$$P(IBFLINE,4),IBBEG=$$STRIP(IBBEG) ; start date
S IBEND=$$P(IBFLINE,5),IBEND=$$STRIP(IBEND) ; end date
S IBZIP=$$P(IBFLINE,6),IBZIP=$$STRIP(IBZIP) ; 3-digit zip
S IBLMT=$$P(IBFLINE,7),IBLMT=$$STRIP(IBLMT) ; site limited flag
;
S LINE=IBSITE_U_IBAF_U_IBBEG_U_IBEND_U_IBLMT
S IBXIFN=$$SET(IBFILE,IBXTMP,LINE) D SETSITE(IBXTMP,IBXIFN,IBSITE,IBNAME,IBZIP)
;
Q
;
E ; Physician CPT Charges: process a single line, parse out into individual fields and store in XTMP
N IBCPT,IBMOD,IBDESC,IBCG,IBWE,IBPE,IBCV,IBBEG,IBEND,LINE,IBXIFN,IBXTMP S IBXTMP="IBCR RC E"
;
S IBCPT=$$P(IBFLINE,1),IBCPT=$$STRIP(IBCPT) I IBCPT'?5NU Q ; CPT
S IBMOD="" ;IBMOD=$$P(IBFLINE,2),IBMOD=$$STRIP(IBMOD),IBMOD=$S('IBMOD:"",1:IBMOD) ; modifier
S IBDESC=$$P(IBFLINE,3) ; description
S IBCG=$$P(IBFLINE,4) ; code group
S IBWE=$$P(IBFLINE,5),IBWE=$$STRIP(IBWE) ; work expense
S IBPE=$$P(IBFLINE,6),IBPE=$$STRIP(IBPE) ; practice expense
S IBCV=$$P(IBFLINE,7),IBCV=$$STRIP(IBCV) ; conversion factor
S IBBEG=$$P(IBFLINE,8),IBBEG=$$STRIP(IBBEG) ; start date
S IBEND=$$P(IBFLINE,9),IBEND=$$STRIP(IBEND) ; end date
;
S LINE=IBCPT_U_IBMOD_U_IBWE_U_IBPE_U_IBCG_U_IBCV_U_IBBEG_U_IBEND S IBXIFN=$$SET(IBFILE,IBXTMP,LINE)
;
Q
;
F ; Physician CPT Charges (A&P): process a single line, parse out into individual fields and store in XTMP
N IBCPT,IBMOD,IBDESC,IBCG,IBCHG,IBBEG,IBEND,LINE,IBXIFN,IBXTMP S IBXTMP="IBCR RC F"
;
S IBCPT=$$P(IBFLINE,1),IBCPT=$$STRIP(IBCPT) I IBCPT'?5NU Q ; CPT
S IBMOD="" ;IBMOD=$$P(IBFLINE,2),IBMOD=$$STRIP(IBMOD),IBMOD=$S('IBMOD:"",1:IBMOD) ; modifier
S IBDESC=$$P(IBFLINE,3) ; description
S IBCG=$$P(IBFLINE,4) ; code group
S IBCHG=$$P(IBFLINE,5),IBCHG=$$STRIP(IBCHG) ; average charge
S IBBEG=$$P(IBFLINE,6),IBBEG=$$STRIP(IBBEG) ; start date
S IBEND=$$P(IBFLINE,7),IBEND=$$STRIP(IBEND) ; end date
;
S LINE=IBCPT_U_IBMOD_U_IBCHG_U_IBCG_U_IBBEG_U_IBEND S IBXIFN=$$SET(IBFILE,IBXTMP,LINE)
;
Q
;
G ; Physician CPT Charges (ET): process a single line, parse out into individual fields and store in XTMP
N IBCPT,IBMOD,IBDESC,IBCG,IBTRVU,IBCV,IBBEG,IBEND,LINE,IBXIFN,IBXTMP S IBXTMP="IBCR RC G"
;
S IBCPT=$$P(IBFLINE,1),IBCPT=$$STRIP(IBCPT) I IBCPT'?5NU Q ; CPT
S IBMOD="" ;IBMOD=$$P(IBFLINE,2),IBMOD=$$STRIP(IBMOD),IBMOD=$S('IBMOD:"",1:IBMOD) ; modifier
S IBDESC=$$P(IBFLINE,3) ; description
S IBCG=$$P(IBFLINE,4) ; code group
S IBTRVU=$$P(IBFLINE,5),IBTRVU=$$STRIP(IBTRVU) ; total rvu
S IBCV=$$P(IBFLINE,6),IBCV=$$STRIP(IBCV) ; conversion factor
S IBBEG=$$P(IBFLINE,7),IBBEG=$$STRIP(IBBEG) ; start date
S IBEND=$$P(IBFLINE,8),IBEND=$$STRIP(IBEND) ; end date
;
S LINE=IBCPT_U_IBMOD_U_IBTRVU_U_IBCG_U_IBCV_U_IBBEG_U_IBEND S IBXIFN=$$SET(IBFILE,IBXTMP,LINE)
;
Q
;
H ; Physician Area Factors: process a single line, parse out into individual fields and store in XTMP
N IBSITE,IBNAME,IBWA,IBWE,IBPE,IBBEG,IBEND,IBZIP,IBX,IBK,LINE,LINE2,IBXIFN,IBXTMP S IBXTMP="IBCR RC H"
;
S IBSITE=$$P(IBFLINE,1),IBSITE=$$STRIP(IBSITE) Q:IBSITE'?3N.UN ; site
S IBNAME=$$P(IBFLINE,2) ; facility name
S IBWA=$$P(IBFLINE,3),IBWA=$$STRIP(IBWA) ; work adjuster
S IBWE=$$P(IBFLINE,4),IBWE=$$STRIP(IBWE) ; work expense
S IBPE=$$P(IBFLINE,5),IBPE=$$STRIP(IBPE) ; practice expense
S IBBEG=$$P(IBFLINE,30),IBBEG=$$STRIP(IBBEG) ; start date
S IBEND=$$P(IBFLINE,31),IBEND=$$STRIP(IBEND) ; end date
S IBZIP=$$P(IBFLINE,32),IBZIP=$$STRIP(IBZIP) ; 3-digit zip
;
S LINE2="" F IBK=6:1:29 S IBX=$$P(IBFLINE,IBK),IBX=$$STRIP(IBX),LINE2=LINE2_IBX_U
;
S LINE=IBSITE_U_IBWA_U_IBWE_U_IBPE_U_IBBEG_U_IBEND
S IBXIFN=$$SET(IBFILE,IBXTMP,LINE) D SET1(IBXTMP,IBXIFN,"BC",LINE2),SETSITE(IBXTMP,IBXIFN,IBSITE,IBNAME,IBZIP)
;
Q
;
I ; Physician Unit Area Factors: process a single line, parse out into individual fields and store in XTMP
N IBSITE,IBNAME,IBAF,IBBEG,IBEND,IBZIP,LINE,IBXIFN,IBXTMP S IBXTMP="IBCR RC I"
;
S IBSITE=$$P(IBFLINE,1),IBSITE=$$STRIP(IBSITE) Q:IBSITE'?3N.UN ; site
S IBNAME=$$P(IBFLINE,2) ; facility name
S IBAF=$$P(IBFLINE,3),IBAF=$$STRIP(IBAF) ; area factor
S IBBEG=$$P(IBFLINE,4),IBBEG=$$STRIP(IBBEG) ; start date
S IBEND=$$P(IBFLINE,5),IBEND=$$STRIP(IBEND) ; end date
S IBZIP=$$P(IBFLINE,6),IBZIP=$$STRIP(IBZIP) ; 3-digit zip
;
S LINE=IBSITE_U_IBAF_U_IBBEG_U_IBEND
S IBXIFN=$$SET(IBFILE,IBXTMP,LINE) D SETSITE(IBXTMP,IBXIFN,IBSITE,IBNAME,IBZIP)
;
Q
;
SETHDR(IBFILE,IBXRF1) ; set up header for XTMP file
;
N IBX S IBX=IBFILE_" RC v"_$G(VERS)_" Host File Upload, "_$P($$HTE^XLFDT($H,2),":",1,2)_" by "_$P($G(^VA(200,+$G(DUZ),0)),U,1)
S ^XTMP(IBXRF1,0)=$$FMADD^XLFDT(DT,2)_U_DT_U_IBX_U_0_U_0
I IBXRF1="IBCR RC SITE" S ^XTMP(IBXRF1,"VERSION")=$G(VERS),^XTMP(IBXRF1,"VERSION INACTIVE")=$$VERSEDT^IBCRHBRV($G(VERS))
Q
;
SET(IBFILE,IBXRF1,LINE) ; set data parsed from host file to XTMP
N IBX,IBK
S IBX=$G(^XTMP(IBXRF1,0)) I IBX="" D SETHDR(IBFILE,IBXRF1)
S IBK=+$P(IBX,U,5)+1,$P(^XTMP(IBXRF1,0),U,5)=IBK
S ^XTMP(IBXRF1,IBK)=LINE
Q IBK
;
SET1(IBXRF1,IBXIFN,IBXRF3,LINE) ; set data parsed from host file to XTMP, second line
;
S ^XTMP(IBXRF1,IBXIFN,IBXRF3)=LINE
Q
;
SETSITE(IBXTMP,IBXIFN,SITE,NAME,ZIP) ; set up site file and xref
;
N IBX,IBK,IBI,IBXRF1,IBJ I SITE=""!(NAME="") Q
S IBXRF1="IBCR RC SITE" S ZIP=$G(ZIP) I ZIP'?3N S ZIP=""
S IBX=$G(^XTMP(IBXRF1,0)) I IBX="" D SETHDR("RC SITE LIST",IBXRF1)
;
S IBK=0 F S IBK=$O(^XTMP(IBXRF1,"B",NAME,IBK)) Q:'IBK S IBX=$G(^XTMP(IBXRF1,IBK)) I $P(IBX,U,1)=SITE Q
;
I +IBK,ZIP'="" S IBX=$G(^XTMP(IBXRF1,IBK)) D
. I $P(IBX,U,3)'="",$P(IBX,U,3)'=ZIP W !,?10,"SITE ERROR: ",IBX,"--",ZIP S IBK=0 Q
. S $P(^XTMP(IBXRF1,IBK),U,3)=ZIP
. S IBI="ZC "_ZIP S ^XTMP(IBXRF1,"B",IBI,IBK)=""
;
I 'IBK D
. S IBK=$P(^XTMP(IBXRF1,0),U,5)+1,$P(^XTMP(IBXRF1,0),U,5)=IBK
. S ^XTMP(IBXRF1,IBK)=SITE_U_NAME_U_ZIP
. ;
. I NAME'="" S IBI=NAME S ^XTMP(IBXRF1,"B",IBI,IBK)=""
. I ZIP'="" S IBI="ZC "_ZIP S ^XTMP(IBXRF1,"B",IBI,IBK)=""
. I SITE'="" S IBI=SITE_" " S ^XTMP(IBXRF1,"B",IBI,IBK)="",^XTMP(IBXRF1,"C",IBI,IBK)=""
;
S ^XTMP(IBXRF1,IBK,IBXTMP)=IBXIFN
Q
;
;
STRIP(IBVAL) ; strip blanks, $, and commas
N IBI,IBY,IBX S IBY=""
F IBI=1:1:200 S IBX=$E(IBVAL,IBI) Q:IBX="" I IBX'=" ",IBX'=",",IBX'="$" S IBY=IBY_IBX
Q IBY
;
;
P(LINE,P) ; parse the line and return the piece requested (replaces $P since may be two dilimiters)
; the pieces are delimited by a comma, any piece that includes a comma within the text is surrounded by quotes
N I,U1,U2,PC S U1=",",U2="""",PC=""
;
F I=1:1:P D
. I $E(LINE)=U2 S LINE=$E(LINE,2,9999),PC=$P(LINE,U2,1),LINE=$P(LINE,U2_U1,2,9999) Q
. ;
. S PC=$P(LINE,U1,1),LINE=$P(LINE,U1,2,9999)
;
Q PC
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCRHBR3 9596 printed Dec 13, 2024@02:19:16 Page 2
IBCRHBR3 ;ALB/ARH - RATES: UPLOAD HOST FILES (RC) PARSE ; 10-OCT-1998
+1 ;;2.0;INTEGRATED BILLING;**106,138,148,169**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ; IBFLINE required and VERS expected on entry
+5 ;
A ; Inpatient Facility DRG Charges: process a single line, parse out into individual fields and store in XTMP
+1 NEW IBDRG,IBSNS,IBDESC,IBRB,IBANC,IBBEG,IBEND,LINE,IBXIFN,IBXTMP
SET IBXTMP="IBCR RC A"
+2 ;
+3 ; DRG
SET IBDRG=$$P(IBFLINE,1)
SET IBDRG=$$STRIP(IBDRG)
if IBDRG'?3N
QUIT
+4 ; description
SET IBDESC=$$P(IBFLINE,2)
+5 ; surgery/non-surgery
SET IBSNS=$$P(IBFLINE,3)
SET IBSNS=$$STRIP(IBSNS)
+6 ; room & board
SET IBRB=$$P(IBFLINE,4)
SET IBRB=$$STRIP(IBRB)
+7 ; ancillary
SET IBANC=$$P(IBFLINE,5)
SET IBANC=$$STRIP(IBANC)
+8 ; start date
SET IBBEG=$$P(IBFLINE,6)
SET IBBEG=$$STRIP(IBBEG)
+9 ; end date
SET IBEND=$$P(IBFLINE,7)
SET IBEND=$$STRIP(IBEND)
+10 ;
+11 SET LINE=IBDRG_U_IBSNS_U_IBRB_U_IBANC_U_IBBEG_U_IBEND
SET IBXIFN=$$SET(IBFILE,IBXTMP,LINE)
+12 ;
+13 QUIT
+14 ;
B ; Inpatient Facility Area Factors: process a single line, parse out into individual fields and store in XTMP
+1 NEW IBSITE,IBNAME,IBSRB,IBSAN,IBNRB,IBNAN,IBSNF,IBBEG,IBEND,LINE,IBXIFN,IBXTMP
SET IBXTMP="IBCR RC B"
+2 ;
+3 ; site
SET IBSITE=$$P(IBFLINE,1)
SET IBSITE=$$STRIP(IBSITE)
if IBSITE'?3N.UN
QUIT
+4 ; facility name
SET IBNAME=$$P(IBFLINE,2)
+5 ; surgical room&board
SET IBSRB=$$P(IBFLINE,3)
SET IBSRB=$$STRIP(IBSRB)
+6 ; surgical ancillary
SET IBSAN=$$P(IBFLINE,4)
SET IBSAN=$$STRIP(IBSAN)
+7 ; non-surgical room&board
SET IBNRB=$$P(IBFLINE,5)
SET IBNRB=$$STRIP(IBNRB)
+8 ; non-surgical ancillary
SET IBNAN=$$P(IBFLINE,6)
SET IBNAN=$$STRIP(IBNAN)
+9 ; skilled nursing
SET IBSNF=$$P(IBFLINE,7)
SET IBSNF=$$STRIP(IBSNF)
+10 ; start date
SET IBBEG=$$P(IBFLINE,8)
SET IBBEG=$$STRIP(IBBEG)
+11 ; end date
SET IBEND=$$P(IBFLINE,9)
SET IBEND=$$STRIP(IBEND)
+12 ;
+13 SET LINE=IBSITE_U_IBSRB_U_IBSAN_U_IBNRB_U_IBNAN_U_IBSNF_U_IBBEG_U_IBEND
+14 SET IBXIFN=$$SET(IBFILE,IBXTMP,LINE)
DO SETSITE(IBXTMP,IBXIFN,IBSITE,IBNAME)
+15 ;
+16 QUIT
+17 ;
C ; Outpatient Facility CPT Charges: process a single line, parse out into individual fields and store in XTMP
+1 NEW IBCPT,IBCHG,IBBEG,IBEND,IBLMT,LINE,IBXIFN,IBXTMP
SET IBXTMP="IBCR RC C"
+2 ;
+3 ; CPT
SET IBCPT=$$P(IBFLINE,1)
SET IBCPT=$$STRIP(IBCPT)
IF IBCPT'?5NU
QUIT
+4 ; charge
SET IBCHG=$$P(IBFLINE,2)
SET IBCHG=$$STRIP(IBCHG)
+5 ; start date
SET IBBEG=$$P(IBFLINE,3)
SET IBBEG=$$STRIP(IBBEG)
+6 ; end date
SET IBEND=$$P(IBFLINE,4)
SET IBEND=$$STRIP(IBEND)
+7 ; site limited flag
SET IBLMT=$$P(IBFLINE,5)
SET IBLMT=$$STRIP(IBLMT)
+8 ;
+9 SET LINE=IBCPT_U_IBCHG_U_IBBEG_U_IBEND_U_IBLMT
SET IBXIFN=$$SET(IBFILE,IBXTMP,LINE)
+10 ;
+11 QUIT
+12 ;
D ; Outpatient Facility Area Factors: process a single line, parse out into individual fields and store in XTMP
+1 NEW IBSITE,IBNAME,IBAF,IBBEG,IBEND,IBZIP,IBLMT,LINE,IBXIFN,IBXTMP
SET IBXTMP="IBCR RC D"
+2 ;
+3 ; site
SET IBSITE=$$P(IBFLINE,1)
SET IBSITE=$$STRIP(IBSITE)
if IBSITE'?3N.UN
QUIT
+4 ; facility name
SET IBNAME=$$P(IBFLINE,2)
+5 ; area factor
SET IBAF=$$P(IBFLINE,3)
SET IBAF=$$STRIP(IBAF)
+6 ; start date
SET IBBEG=$$P(IBFLINE,4)
SET IBBEG=$$STRIP(IBBEG)
+7 ; end date
SET IBEND=$$P(IBFLINE,5)
SET IBEND=$$STRIP(IBEND)
+8 ; 3-digit zip
SET IBZIP=$$P(IBFLINE,6)
SET IBZIP=$$STRIP(IBZIP)
+9 ; site limited flag
SET IBLMT=$$P(IBFLINE,7)
SET IBLMT=$$STRIP(IBLMT)
+10 ;
+11 SET LINE=IBSITE_U_IBAF_U_IBBEG_U_IBEND_U_IBLMT
+12 SET IBXIFN=$$SET(IBFILE,IBXTMP,LINE)
DO SETSITE(IBXTMP,IBXIFN,IBSITE,IBNAME,IBZIP)
+13 ;
+14 QUIT
+15 ;
E ; Physician CPT Charges: process a single line, parse out into individual fields and store in XTMP
+1 NEW IBCPT,IBMOD,IBDESC,IBCG,IBWE,IBPE,IBCV,IBBEG,IBEND,LINE,IBXIFN,IBXTMP
SET IBXTMP="IBCR RC E"
+2 ;
+3 ; CPT
SET IBCPT=$$P(IBFLINE,1)
SET IBCPT=$$STRIP(IBCPT)
IF IBCPT'?5NU
QUIT
+4 ;IBMOD=$$P(IBFLINE,2),IBMOD=$$STRIP(IBMOD),IBMOD=$S('IBMOD:"",1:IBMOD) ; modifier
SET IBMOD=""
+5 ; description
SET IBDESC=$$P(IBFLINE,3)
+6 ; code group
SET IBCG=$$P(IBFLINE,4)
+7 ; work expense
SET IBWE=$$P(IBFLINE,5)
SET IBWE=$$STRIP(IBWE)
+8 ; practice expense
SET IBPE=$$P(IBFLINE,6)
SET IBPE=$$STRIP(IBPE)
+9 ; conversion factor
SET IBCV=$$P(IBFLINE,7)
SET IBCV=$$STRIP(IBCV)
+10 ; start date
SET IBBEG=$$P(IBFLINE,8)
SET IBBEG=$$STRIP(IBBEG)
+11 ; end date
SET IBEND=$$P(IBFLINE,9)
SET IBEND=$$STRIP(IBEND)
+12 ;
+13 SET LINE=IBCPT_U_IBMOD_U_IBWE_U_IBPE_U_IBCG_U_IBCV_U_IBBEG_U_IBEND
SET IBXIFN=$$SET(IBFILE,IBXTMP,LINE)
+14 ;
+15 QUIT
+16 ;
F ; Physician CPT Charges (A&P): process a single line, parse out into individual fields and store in XTMP
+1 NEW IBCPT,IBMOD,IBDESC,IBCG,IBCHG,IBBEG,IBEND,LINE,IBXIFN,IBXTMP
SET IBXTMP="IBCR RC F"
+2 ;
+3 ; CPT
SET IBCPT=$$P(IBFLINE,1)
SET IBCPT=$$STRIP(IBCPT)
IF IBCPT'?5NU
QUIT
+4 ;IBMOD=$$P(IBFLINE,2),IBMOD=$$STRIP(IBMOD),IBMOD=$S('IBMOD:"",1:IBMOD) ; modifier
SET IBMOD=""
+5 ; description
SET IBDESC=$$P(IBFLINE,3)
+6 ; code group
SET IBCG=$$P(IBFLINE,4)
+7 ; average charge
SET IBCHG=$$P(IBFLINE,5)
SET IBCHG=$$STRIP(IBCHG)
+8 ; start date
SET IBBEG=$$P(IBFLINE,6)
SET IBBEG=$$STRIP(IBBEG)
+9 ; end date
SET IBEND=$$P(IBFLINE,7)
SET IBEND=$$STRIP(IBEND)
+10 ;
+11 SET LINE=IBCPT_U_IBMOD_U_IBCHG_U_IBCG_U_IBBEG_U_IBEND
SET IBXIFN=$$SET(IBFILE,IBXTMP,LINE)
+12 ;
+13 QUIT
+14 ;
G ; Physician CPT Charges (ET): process a single line, parse out into individual fields and store in XTMP
+1 NEW IBCPT,IBMOD,IBDESC,IBCG,IBTRVU,IBCV,IBBEG,IBEND,LINE,IBXIFN,IBXTMP
SET IBXTMP="IBCR RC G"
+2 ;
+3 ; CPT
SET IBCPT=$$P(IBFLINE,1)
SET IBCPT=$$STRIP(IBCPT)
IF IBCPT'?5NU
QUIT
+4 ;IBMOD=$$P(IBFLINE,2),IBMOD=$$STRIP(IBMOD),IBMOD=$S('IBMOD:"",1:IBMOD) ; modifier
SET IBMOD=""
+5 ; description
SET IBDESC=$$P(IBFLINE,3)
+6 ; code group
SET IBCG=$$P(IBFLINE,4)
+7 ; total rvu
SET IBTRVU=$$P(IBFLINE,5)
SET IBTRVU=$$STRIP(IBTRVU)
+8 ; conversion factor
SET IBCV=$$P(IBFLINE,6)
SET IBCV=$$STRIP(IBCV)
+9 ; start date
SET IBBEG=$$P(IBFLINE,7)
SET IBBEG=$$STRIP(IBBEG)
+10 ; end date
SET IBEND=$$P(IBFLINE,8)
SET IBEND=$$STRIP(IBEND)
+11 ;
+12 SET LINE=IBCPT_U_IBMOD_U_IBTRVU_U_IBCG_U_IBCV_U_IBBEG_U_IBEND
SET IBXIFN=$$SET(IBFILE,IBXTMP,LINE)
+13 ;
+14 QUIT
+15 ;
H ; Physician Area Factors: process a single line, parse out into individual fields and store in XTMP
+1 NEW IBSITE,IBNAME,IBWA,IBWE,IBPE,IBBEG,IBEND,IBZIP,IBX,IBK,LINE,LINE2,IBXIFN,IBXTMP
SET IBXTMP="IBCR RC H"
+2 ;
+3 ; site
SET IBSITE=$$P(IBFLINE,1)
SET IBSITE=$$STRIP(IBSITE)
if IBSITE'?3N.UN
QUIT
+4 ; facility name
SET IBNAME=$$P(IBFLINE,2)
+5 ; work adjuster
SET IBWA=$$P(IBFLINE,3)
SET IBWA=$$STRIP(IBWA)
+6 ; work expense
SET IBWE=$$P(IBFLINE,4)
SET IBWE=$$STRIP(IBWE)
+7 ; practice expense
SET IBPE=$$P(IBFLINE,5)
SET IBPE=$$STRIP(IBPE)
+8 ; start date
SET IBBEG=$$P(IBFLINE,30)
SET IBBEG=$$STRIP(IBBEG)
+9 ; end date
SET IBEND=$$P(IBFLINE,31)
SET IBEND=$$STRIP(IBEND)
+10 ; 3-digit zip
SET IBZIP=$$P(IBFLINE,32)
SET IBZIP=$$STRIP(IBZIP)
+11 ;
+12 SET LINE2=""
FOR IBK=6:1:29
SET IBX=$$P(IBFLINE,IBK)
SET IBX=$$STRIP(IBX)
SET LINE2=LINE2_IBX_U
+13 ;
+14 SET LINE=IBSITE_U_IBWA_U_IBWE_U_IBPE_U_IBBEG_U_IBEND
+15 SET IBXIFN=$$SET(IBFILE,IBXTMP,LINE)
DO SET1(IBXTMP,IBXIFN,"BC",LINE2)
DO SETSITE(IBXTMP,IBXIFN,IBSITE,IBNAME,IBZIP)
+16 ;
+17 QUIT
+18 ;
I ; Physician Unit Area Factors: process a single line, parse out into individual fields and store in XTMP
+1 NEW IBSITE,IBNAME,IBAF,IBBEG,IBEND,IBZIP,LINE,IBXIFN,IBXTMP
SET IBXTMP="IBCR RC I"
+2 ;
+3 ; site
SET IBSITE=$$P(IBFLINE,1)
SET IBSITE=$$STRIP(IBSITE)
if IBSITE'?3N.UN
QUIT
+4 ; facility name
SET IBNAME=$$P(IBFLINE,2)
+5 ; area factor
SET IBAF=$$P(IBFLINE,3)
SET IBAF=$$STRIP(IBAF)
+6 ; start date
SET IBBEG=$$P(IBFLINE,4)
SET IBBEG=$$STRIP(IBBEG)
+7 ; end date
SET IBEND=$$P(IBFLINE,5)
SET IBEND=$$STRIP(IBEND)
+8 ; 3-digit zip
SET IBZIP=$$P(IBFLINE,6)
SET IBZIP=$$STRIP(IBZIP)
+9 ;
+10 SET LINE=IBSITE_U_IBAF_U_IBBEG_U_IBEND
+11 SET IBXIFN=$$SET(IBFILE,IBXTMP,LINE)
DO SETSITE(IBXTMP,IBXIFN,IBSITE,IBNAME,IBZIP)
+12 ;
+13 QUIT
+14 ;
SETHDR(IBFILE,IBXRF1) ; set up header for XTMP file
+1 ;
+2 NEW IBX
SET IBX=IBFILE_" RC v"_$GET(VERS)_" Host File Upload, "_$PIECE($$HTE^XLFDT($HOROLOG,2),":",1,2)_" by "_$PIECE($GET(^VA(200,+$GET(DUZ),0)),U,1)
+3 SET ^XTMP(IBXRF1,0)=$$FMADD^XLFDT(DT,2)_U_DT_U_IBX_U_0_U_0
+4 IF IBXRF1="IBCR RC SITE"
SET ^XTMP(IBXRF1,"VERSION")=$GET(VERS)
SET ^XTMP(IBXRF1,"VERSION INACTIVE")=$$VERSEDT^IBCRHBRV($GET(VERS))
+5 QUIT
+6 ;
SET(IBFILE,IBXRF1,LINE) ; set data parsed from host file to XTMP
+1 NEW IBX,IBK
+2 SET IBX=$GET(^XTMP(IBXRF1,0))
IF IBX=""
DO SETHDR(IBFILE,IBXRF1)
+3 SET IBK=+$PIECE(IBX,U,5)+1
SET $PIECE(^XTMP(IBXRF1,0),U,5)=IBK
+4 SET ^XTMP(IBXRF1,IBK)=LINE
+5 QUIT IBK
+6 ;
SET1(IBXRF1,IBXIFN,IBXRF3,LINE) ; set data parsed from host file to XTMP, second line
+1 ;
+2 SET ^XTMP(IBXRF1,IBXIFN,IBXRF3)=LINE
+3 QUIT
+4 ;
SETSITE(IBXTMP,IBXIFN,SITE,NAME,ZIP) ; set up site file and xref
+1 ;
+2 NEW IBX,IBK,IBI,IBXRF1,IBJ
IF SITE=""!(NAME="")
QUIT
+3 SET IBXRF1="IBCR RC SITE"
SET ZIP=$GET(ZIP)
IF ZIP'?3N
SET ZIP=""
+4 SET IBX=$GET(^XTMP(IBXRF1,0))
IF IBX=""
DO SETHDR("RC SITE LIST",IBXRF1)
+5 ;
+6 SET IBK=0
FOR
SET IBK=$ORDER(^XTMP(IBXRF1,"B",NAME,IBK))
if 'IBK
QUIT
SET IBX=$GET(^XTMP(IBXRF1,IBK))
IF $PIECE(IBX,U,1)=SITE
QUIT
+7 ;
+8 IF +IBK
IF ZIP'=""
SET IBX=$GET(^XTMP(IBXRF1,IBK))
Begin DoDot:1
+9 IF $PIECE(IBX,U,3)'=""
IF $PIECE(IBX,U,3)'=ZIP
WRITE !,?10,"SITE ERROR: ",IBX,"--",ZIP
SET IBK=0
QUIT
+10 SET $PIECE(^XTMP(IBXRF1,IBK),U,3)=ZIP
+11 SET IBI="ZC "_ZIP
SET ^XTMP(IBXRF1,"B",IBI,IBK)=""
End DoDot:1
+12 ;
+13 IF 'IBK
Begin DoDot:1
+14 SET IBK=$PIECE(^XTMP(IBXRF1,0),U,5)+1
SET $PIECE(^XTMP(IBXRF1,0),U,5)=IBK
+15 SET ^XTMP(IBXRF1,IBK)=SITE_U_NAME_U_ZIP
+16 ;
+17 IF NAME'=""
SET IBI=NAME
SET ^XTMP(IBXRF1,"B",IBI,IBK)=""
+18 IF ZIP'=""
SET IBI="ZC "_ZIP
SET ^XTMP(IBXRF1,"B",IBI,IBK)=""
+19 IF SITE'=""
SET IBI=SITE_" "
SET ^XTMP(IBXRF1,"B",IBI,IBK)=""
SET ^XTMP(IBXRF1,"C",IBI,IBK)=""
End DoDot:1
+20 ;
+21 SET ^XTMP(IBXRF1,IBK,IBXTMP)=IBXIFN
+22 QUIT
+23 ;
+24 ;
STRIP(IBVAL) ; strip blanks, $, and commas
+1 NEW IBI,IBY,IBX
SET IBY=""
+2 FOR IBI=1:1:200
SET IBX=$EXTRACT(IBVAL,IBI)
if IBX=""
QUIT
IF IBX'=" "
IF IBX'=","
IF IBX'="$"
SET IBY=IBY_IBX
+3 QUIT IBY
+4 ;
+5 ;
P(LINE,P) ; parse the line and return the piece requested (replaces $P since may be two dilimiters)
+1 ; the pieces are delimited by a comma, any piece that includes a comma within the text is surrounded by quotes
+2 NEW I,U1,U2,PC
SET U1=","
SET U2=""""
SET PC=""
+3 ;
+4 FOR I=1:1:P
Begin DoDot:1
+5 IF $EXTRACT(LINE)=U2
SET LINE=$EXTRACT(LINE,2,9999)
SET PC=$PIECE(LINE,U2,1)
SET LINE=$PIECE(LINE,U2_U1,2,9999)
QUIT
+6 ;
+7 SET PC=$PIECE(LINE,U1,1)
SET LINE=$PIECE(LINE,U1,2,9999)
End DoDot:1
+8 ;
+9 QUIT PC
