- IBCRHBRV ;ALB/ARH - RATES: UPLOAD (RC) VERSION FUNCTIONS ; 14-FEB-01
- ;;2.0;INTEGRATED BILLING;**148,169,245,270,285,298,325,334,355,360,365,382,390,408,412,423,427,439,445,462,468,484,491,508,520,536,542,556,559,573,584,600,612,628,634,658,667,683,693,719,724,744,755,783**;21-MAR-94;Build 2
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- ; RC functions related to Version. Update VLIST with new versions. Update FTYPE if new types of files.
- ;
- SELVERS() ; get version to upload from user
- N DIR,DIRUT,DTOUT,DUOUT,IBVLIST,IBQUIT,IBVERS,IBI,IBJ,IBX,X,Y
- ;
- S IBVLIST=$$VERSTR(),IBQUIT=0,IBVERS=0
- ;
- W !!,"Select the version of Reasonable Charges to upload."
- S DIR("?",1)="Enter the code from the list corresponding to the version of Reasonable Charges"
- S DIR("?",2)="to upload. There are no version 1.3, 2.2, or 2.10 (ten) RC charges." S DIR("?",3)=" "
- S DIR("?",4)="Versions: "_IBVLIST S DIR("?",5)=" " S DIR("?")="Enter version number to upload."
- ;
- F IBI=1:1 D I +IBQUIT Q
- . W !!,?5,"Select one of the following:",!
- . F IBJ=1:1 S IBX=$P(IBVLIST,",",IBJ) Q:'IBX W !,?10,IBX,?20,"Reasonable Charges version ",IBX
- . ;
- . W ! S DIR("A")="Enter Version" S DIR(0)="FO^1:5" D ^DIR I $D(DIRUT) S IBQUIT=1
- . I Y>0,(","_IBVLIST_",")[(","_Y_",") S IBVERS=Y,IBQUIT=1 W " Reasonable Charges version ",IBVERS
- ;
- Q IBVERS
- ;
- VERSION() ; return currently loaded version of RC files (1, 1.1, ...)
- N IBX S IBX=$G(^XTMP("IBCR RC SITE","VERSION"))
- Q IBX
- ;
- VERSDT(VERS) ; return Effective Date of a version of RC files, either version passed in or currently loaded version
- N IBI,LINE,IBX S IBX="" S VERS=+$G(VERS) I 'VERS S VERS=$$VERSION
- I +VERS F IBI=1:1 S LINE=$P($T(VLIST+IBI),";;",2,99) Q:'LINE I VERS=+LINE S IBX=$P(LINE,U,3)
- Q IBX
- ;
- VERSEDT(VERS) ; return Inactive Date of a version of RC files, either version passed in or currently loaded version
- N IBI,LINE,IBX S IBX="" S VERS=+$G(VERS) I 'VERS S VERS=$$VERSION
- I +VERS F IBI=1:1 S LINE=$P($T(VLIST+IBI),";;",2,99) Q:'LINE I VERS=+LINE S IBX=$P(LINE,U,4)
- Q IBX
- ;
- VERSALL() ; return all RC versions and corresponding effective date 'VERS;EFFDT^VERS;EFFDT^...'
- N IBI,LINE,IBX,IBC S IBX="",IBC=""
- F IBI=1:1 S LINE=$P($T(VLIST+IBI),";;",2,99) Q:'LINE S IBX=IBX_IBC_+LINE_";"_$P(LINE,U,3),IBC=U
- Q IBX
- ;
- VERSEND() ; return all RC versions and corresponding inactive date 'VERS;INACTIVE DT^VERS;INACTIVE DT^...'
- N IBI,LINE,IBX,IBC S IBX="",IBC=""
- F IBI=1:1 S LINE=$P($T(VLIST+IBI),";;",2,99) Q:'LINE I $P(LINE,U,4) S IBX=IBX_IBC_+LINE_";"_$P(LINE,U,4),IBC=U
- Q IBX
- ;
- VERSITE(SITE) ; returns the list of versions loaded for a particular site
- ; *** uses 99201 in the RC PHYSICIAN set to check which versions/dates are loaded
- ; *** so 99201 must have a pro charge in all versions, if not it must be replaced with an item that does
- ; *693 - 99202 for 4.215
- N IBCS,IBXRF,IBITM,IBITM2,IBVERS,IBCSFN,IBI,IBV,IBX,IBY,IBC
- S IBVERS=$$VERSALL,IBITM=99201,IBITM2=99202
- ;
- I $G(SITE)'="" S IBCS="RC-PHYSICIAN" F S IBCS=$O(^IBE(363.1,"B",IBCS)) Q:IBCS'["RC-PHYSICIAN" D
- . S IBV=$L(IBCS," ") I $P(IBCS," ",IBV)'=SITE Q
- . S IBCSFN=$O(^IBE(363.1,"B",IBCS,0)) Q:'IBCSFN S IBXRF="AIVDTS"_IBCSFN
- . F IBI=1:1 S IBV=$P(IBVERS,U,IBI) Q:'IBV I ($O(^IBA(363.2,IBXRF,IBITM,-$P(IBV,";",2),0)))!($O(^IBA(363.2,IBXRF,IBITM2,-$P(IBV,";",2),0))) S IBY(+IBV)=""
- ;
- S (IBX,IBC)="" F IBI=1:1 S IBV=+$P(IBVERS,U,IBI) Q:'IBV I $D(IBY(IBV)) S IBX=IBX_IBC_IBV S IBC=","
- ;
- Q IBX
- ;
- MSGSITE(SITE) ; display a message indicating which versions are loaded for a site
- N IBVERS Q:'$G(SITE)
- S IBVERS=$$VERSITE(SITE)
- I 'IBVERS W !!,?12,"There appear to be no RC charges already loaded for "_SITE_"."
- I +IBVERS W !!,?12,"RC versions "_IBVERS_" appear to be already loaded for "_SITE_"."
- Q
- ;
- MSGVERS(SITE) ; check if versions are being loaded in the correct order, should be loaded in date order
- ; - if loading a version that has already been loaded for the site
- ; - if loading a version when any future versions have already been loaded for the site
- ; - if loading a version when the last version has not yet been loaded for the site
- ; *** uses 99201 in the RC PHYSICIAN set to check which versions/dates are loaded
- ; *** so 99201 must have a pro charge in all versions, if not it must be replaced with an item that does
- N IBVERS,IBVDTC,IBVERSIN,IBVERSC,IBVERSO,IBI,VERSTR Q:'$G(SITE)
- ;
- S IBVERS=$$VERSION Q:'IBVERS S IBVDTC=$$VERSDT,IBVERSIN=","_$$VERSITE(SITE)_",",IBVERSC=","_IBVERS_","
- ;
- ; check if loading a version that has already been loaded
- I IBVERSIN[IBVERSC D
- . W !!,?5,"*** It appears version RC v",IBVERS," has already been loaded for this site ***"
- ;
- ; check if loading a version when any future versions have already been loaded
- S VERSTR=","_$$VERSTR()_",",VERSTR=$P(VERSTR,IBVERSC,2) ; all versions after current version
- F IBI=1:1 S IBVERSO=$P(VERSTR,",",IBI) Q:'IBVERSO I IBVERSIN[(","_IBVERSO_",") D
- . W !!,?5,">>> Currently trying to load RC v"_IBVERS_" but RC v"_IBVERSO_" appears to be already",!,?9,"loaded for this site. The versions should be loaded in date order."
- ;
- ; check if loading a version when the last version has not yet been loaded
- S VERSTR=","_$$VERSTR(1)_",",VERSTR=$P(VERSTR,IBVERSC,2) ; all versions before current version, reverse order
- S IBVERSO=$P(VERSTR,",",1) I +IBVERSO,IBVERSIN'[(","_IBVERSO_",") D
- . W !!,?5,"*** Currently trying to load RC v"_IBVERS_" but RC v"_IBVERSO_" does not appear to be",!,?9,"loaded for this site. The versions should be loaded in date order."
- . W !!,?5,">>> Continue only if there will never be a need to bill events before ",!,?9,$$FMTE^XLFDT(IBVDTC,2)," for this site. If RC v"_IBVERSO_" will be needed for this site then",!,?9,"load it first."
- ;
- Q
- ;
- VERSTR(RVRS) ; returns string containing list of all Reasonable Charges versions with charges, separated by ","
- ; RVRS - if set, returns the list of versions in reverse order
- N IBI,LINE,IBS,IBR,IBC,IBX S (IBS,IBR,IBC,IBX)=""
- F IBI=1:1 S LINE=$P($T(VLIST+IBI),";;",2,99) Q:'LINE S IBS=IBS_IBC_+LINE,IBR=+LINE_IBC_IBR S IBC=","
- S IBX=IBS I +$G(RVRS) S IBX=IBR
- Q IBX
- ;
- ;
- ;
- ;
- ;
- ; File Names: 'IBRCyymmx.TXT' w/ yymm - year month of version release (except v1)
- ; 'IBRCyymm', file version identifier prefix, from VLIST text version description
- ; x=A-I/F, single character file identifier, from FTYPE text file description
- ;
- FILES(IBFILES,VERS) ; returns array of source Host Files and data for version requested, pass IBFILES by reference
- N IBI,LINE,IBTYPE,IBFILE,IBNAME,IBDESC S VERS=+$G(VERS) I 'VERS S VERS=1
- ;
- ; get requested versions data
- F IBI=1:1 S LINE=$P($T(VLIST+IBI),";;",2,99) Q:'LINE I VERS=+LINE S IBTYPE=$P(LINE,U,2),IBFILE=$P(LINE,U,5) Q
- ;
- ; get requested versions files
- I +$G(IBTYPE) F IBI=1:1 S LINE=$P($T(@("FT"_IBTYPE)+IBI),";;",2,99) Q:LINE="" D
- . S IBNAME=IBFILE_$P(LINE,":",1)_".TXT",IBDESC="RC v"_+VERS_" "_$P(LINE,":",2,99)
- . S IBFILES(IBNAME)=IBDESC
- Q
- ;
- ;
- ; versions and their critical data, add new versions here
- VLIST ; version ^ file type/version ^ effective date ^ inactive date ^ file prefix
- ;;1.0^1^2990901^3001101^IBRCV
- ;;1.1^1^3001102^3010507^IBRC0011
- ;;1.2^1^3010508^3030428^IBRC0105
- ;;1.4^1^3030429^3031218^IBRC0304
- ;;2.0^2^3031219^3040414^IBRC0312
- ;;2.1^2^3040415^3041231^IBRC0404
- ;;2.3^2^3050101^3050410^IBRC0501
- ;;2.4^2^3050411^3050930^IBRC0504
- ;;2.5^2^3051001^3051231^IBRC0510
- ;;2.6^2^3060101^3060824^IBRC0601
- ;;2.7^2^3060825^3060930^IBRC0608
- ;;2.8^2^3061001^3061231^IBRC0610
- ;;2.9^2^3070101^3070930^IBRC0701
- ;;2.11^2^3071001^3071231^IBRC0710
- ;;3.1^2^3080101^3080930^IBRC0801
- ;;3.2^2^3081001^3081231^IBRC0810
- ;;3.3^2^3090101^3090930^IBRC0901
- ;;3.4^2^3091001^3091231^IBRC0910
- ;;3.5^2^3100101^3100930^IBRC1001
- ;;3.6^2^3101001^3101231^IBRC1010
- ;;3.7^2^3110101^3110930^IBRC1101
- ;;3.8^2^3111001^3111231^IBRC1110
- ;;3.9^2^3120101^3120930^IBRC1201
- ;;3.11^2^3121001^3121231^IBRC1210
- ;;3.12^2^3130101^3130930^IBRC1301
- ;;3.13^2^3131001^3131231^IBRC1310
- ;;3.14^2^3140101^3140930^IBRC1401
- ;;3.15^2^3141001^3141231^IBRC1410
- ;;3.16^2^3150101^3150930^IBRC1501
- ;;3.17^2^3151001^3151231^IBRC1510
- ;;3.18^2^3160101^3160930^IBRC1601
- ;;3.19^2^3161001^3161231^IBRC1610
- ;;3.21^2^3170101^3170930^IBRC1701
- ;;3.22^2^3171001^3171231^IBRC1710
- ;;3.23^2^3180101^3180930^IBRC1801
- ;;3.24^2^3181001^3181231^IBRC1810
- ;;3.25^2^3190101^3190930^IBRC1901
- ;;3.26^2^3191001^3191231^IBRC1910
- ;;3.27^2^3200101^3200930^IBRC2001
- ;;4.21^2^3201001^3201231^IBRC2010
- ;;4.215^2^3210101^3210930^IBRC2101
- ;;4.22^2^3211001^3211231^IBRC2110
- ;;4.225^2^3220101^3220930^IBRC2201
- ;;4.23^2^3221001^3221231^IBRC2210
- ;;4.235^2^3230101^3231231^IBRC2301
- ;;5.24^2^3240101^^IBRC2401
- ;
- FTYPE ; file type/versions and relevant data
- ; file identifier is used with XTMP subscript 'IBCR RC ' and routine label to parse file
- ; file identifier : file name/description ^ file identifier ^ number of columns (for v2+)
- ;
- FT1 ; Reasonable Charge File Type 1 files
- ;;A:Inpatient Facility Charges^A
- ;;B:Inpatient Facility Area Factors^B
- ;;C:Outpatient Facility Charges^C
- ;;D:Outpatient Facility Area Factors^D
- ;;E:Physician Charges E^E
- ;;F:Physician Charges F^F
- ;;G:Physician Charges G^G
- ;;H:Physician Area Factors^H
- ;;I:Physician Unit Area Factors^I
- ;;
- ;
- FT2 ; Reasonable Charges File Type 2 files
- ;;A:Inpatient Facility Charges^A^10
- ;;B:Outpatient Facility Charges^B^14
- ;;C:Professional Charges^C^23
- ;;D:Service Category Codes^D^4
- ;;E:Area Factors^E^41
- ;;F:VA Sites and Zip Codes^F^4
- ;;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCRHBRV 9709 printed Jan 18, 2025@03:20:35 Page 2
- IBCRHBRV ;ALB/ARH - RATES: UPLOAD (RC) VERSION FUNCTIONS ; 14-FEB-01
- +1 ;;2.0;INTEGRATED BILLING;**148,169,245,270,285,298,325,334,355,360,365,382,390,408,412,423,427,439,445,462,468,484,491,508,520,536,542,556,559,573,584,600,612,628,634,658,667,683,693,719,724,744,755,783**;21-MAR-94;Build 2
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ; RC functions related to Version. Update VLIST with new versions. Update FTYPE if new types of files.
- +5 ;
- SELVERS() ; get version to upload from user
- +1 NEW DIR,DIRUT,DTOUT,DUOUT,IBVLIST,IBQUIT,IBVERS,IBI,IBJ,IBX,X,Y
- +2 ;
- +3 SET IBVLIST=$$VERSTR()
- SET IBQUIT=0
- SET IBVERS=0
- +4 ;
- +5 WRITE !!,"Select the version of Reasonable Charges to upload."
- +6 SET DIR("?",1)="Enter the code from the list corresponding to the version of Reasonable Charges"
- +7 SET DIR("?",2)="to upload. There are no version 1.3, 2.2, or 2.10 (ten) RC charges."
- SET DIR("?",3)=" "
- +8 SET DIR("?",4)="Versions: "_IBVLIST
- SET DIR("?",5)=" "
- SET DIR("?")="Enter version number to upload."
- +9 ;
- +10 FOR IBI=1:1
- Begin DoDot:1
- +11 WRITE !!,?5,"Select one of the following:",!
- +12 FOR IBJ=1:1
- SET IBX=$PIECE(IBVLIST,",",IBJ)
- if 'IBX
- QUIT
- WRITE !,?10,IBX,?20,"Reasonable Charges version ",IBX
- +13 ;
- +14 WRITE !
- SET DIR("A")="Enter Version"
- SET DIR(0)="FO^1:5"
- DO ^DIR
- IF $DATA(DIRUT)
- SET IBQUIT=1
- +15 IF Y>0
- IF (","_IBVLIST_",")[(","_Y_",")
- SET IBVERS=Y
- SET IBQUIT=1
- WRITE " Reasonable Charges version ",IBVERS
- End DoDot:1
- IF +IBQUIT
- QUIT
- +16 ;
- +17 QUIT IBVERS
- +18 ;
- VERSION() ; return currently loaded version of RC files (1, 1.1, ...)
- +1 NEW IBX
- SET IBX=$GET(^XTMP("IBCR RC SITE","VERSION"))
- +2 QUIT IBX
- +3 ;
- VERSDT(VERS) ; return Effective Date of a version of RC files, either version passed in or currently loaded version
- +1 NEW IBI,LINE,IBX
- SET IBX=""
- SET VERS=+$GET(VERS)
- IF 'VERS
- SET VERS=$$VERSION
- +2 IF +VERS
- FOR IBI=1:1
- SET LINE=$PIECE($TEXT(VLIST+IBI),";;",2,99)
- if 'LINE
- QUIT
- IF VERS=+LINE
- SET IBX=$PIECE(LINE,U,3)
- +3 QUIT IBX
- +4 ;
- VERSEDT(VERS) ; return Inactive Date of a version of RC files, either version passed in or currently loaded version
- +1 NEW IBI,LINE,IBX
- SET IBX=""
- SET VERS=+$GET(VERS)
- IF 'VERS
- SET VERS=$$VERSION
- +2 IF +VERS
- FOR IBI=1:1
- SET LINE=$PIECE($TEXT(VLIST+IBI),";;",2,99)
- if 'LINE
- QUIT
- IF VERS=+LINE
- SET IBX=$PIECE(LINE,U,4)
- +3 QUIT IBX
- +4 ;
- VERSALL() ; return all RC versions and corresponding effective date 'VERS;EFFDT^VERS;EFFDT^...'
- +1 NEW IBI,LINE,IBX,IBC
- SET IBX=""
- SET IBC=""
- +2 FOR IBI=1:1
- SET LINE=$PIECE($TEXT(VLIST+IBI),";;",2,99)
- if 'LINE
- QUIT
- SET IBX=IBX_IBC_+LINE_";"_$PIECE(LINE,U,3)
- SET IBC=U
- +3 QUIT IBX
- +4 ;
- VERSEND() ; return all RC versions and corresponding inactive date 'VERS;INACTIVE DT^VERS;INACTIVE DT^...'
- +1 NEW IBI,LINE,IBX,IBC
- SET IBX=""
- SET IBC=""
- +2 FOR IBI=1:1
- SET LINE=$PIECE($TEXT(VLIST+IBI),";;",2,99)
- if 'LINE
- QUIT
- IF $PIECE(LINE,U,4)
- SET IBX=IBX_IBC_+LINE_";"_$PIECE(LINE,U,4)
- SET IBC=U
- +3 QUIT IBX
- +4 ;
- VERSITE(SITE) ; returns the list of versions loaded for a particular site
- +1 ; *** uses 99201 in the RC PHYSICIAN set to check which versions/dates are loaded
- +2 ; *** so 99201 must have a pro charge in all versions, if not it must be replaced with an item that does
- +3 ; *693 - 99202 for 4.215
- +4 NEW IBCS,IBXRF,IBITM,IBITM2,IBVERS,IBCSFN,IBI,IBV,IBX,IBY,IBC
- +5 SET IBVERS=$$VERSALL
- SET IBITM=99201
- SET IBITM2=99202
- +6 ;
- +7 IF $GET(SITE)'=""
- SET IBCS="RC-PHYSICIAN"
- FOR
- SET IBCS=$ORDER(^IBE(363.1,"B",IBCS))
- if IBCS'["RC-PHYSICIAN"
- QUIT
- Begin DoDot:1
- +8 SET IBV=$LENGTH(IBCS," ")
- IF $PIECE(IBCS," ",IBV)'=SITE
- QUIT
- +9 SET IBCSFN=$ORDER(^IBE(363.1,"B",IBCS,0))
- if 'IBCSFN
- QUIT
- SET IBXRF="AIVDTS"_IBCSFN
- +10 FOR IBI=1:1
- SET IBV=$PIECE(IBVERS,U,IBI)
- if 'IBV
- QUIT
- IF ($ORDER(^IBA(363.2,IBXRF,IBITM,-$PIECE(IBV,";",2),0)))!($ORDER(^IBA(363.2,IBXRF,IBITM2,-$PIECE(IBV,";",2),0)))
- SET IBY(+IBV)=""
- End DoDot:1
- +11 ;
- +12 SET (IBX,IBC)=""
- FOR IBI=1:1
- SET IBV=+$PIECE(IBVERS,U,IBI)
- if 'IBV
- QUIT
- IF $DATA(IBY(IBV))
- SET IBX=IBX_IBC_IBV
- SET IBC=","
- +13 ;
- +14 QUIT IBX
- +15 ;
- MSGSITE(SITE) ; display a message indicating which versions are loaded for a site
- +1 NEW IBVERS
- if '$GET(SITE)
- QUIT
- +2 SET IBVERS=$$VERSITE(SITE)
- +3 IF 'IBVERS
- WRITE !!,?12,"There appear to be no RC charges already loaded for "_SITE_"."
- +4 IF +IBVERS
- WRITE !!,?12,"RC versions "_IBVERS_" appear to be already loaded for "_SITE_"."
- +5 QUIT
- +6 ;
- MSGVERS(SITE) ; check if versions are being loaded in the correct order, should be loaded in date order
- +1 ; - if loading a version that has already been loaded for the site
- +2 ; - if loading a version when any future versions have already been loaded for the site
- +3 ; - if loading a version when the last version has not yet been loaded for the site
- +4 ; *** uses 99201 in the RC PHYSICIAN set to check which versions/dates are loaded
- +5 ; *** so 99201 must have a pro charge in all versions, if not it must be replaced with an item that does
- +6 NEW IBVERS,IBVDTC,IBVERSIN,IBVERSC,IBVERSO,IBI,VERSTR
- if '$GET(SITE)
- QUIT
- +7 ;
- +8 SET IBVERS=$$VERSION
- if 'IBVERS
- QUIT
- SET IBVDTC=$$VERSDT
- SET IBVERSIN=","_$$VERSITE(SITE)_","
- SET IBVERSC=","_IBVERS_","
- +9 ;
- +10 ; check if loading a version that has already been loaded
- +11 IF IBVERSIN[IBVERSC
- Begin DoDot:1
- +12 WRITE !!,?5,"*** It appears version RC v",IBVERS," has already been loaded for this site ***"
- End DoDot:1
- +13 ;
- +14 ; check if loading a version when any future versions have already been loaded
- +15 ; all versions after current version
- SET VERSTR=","_$$VERSTR()_","
- SET VERSTR=$PIECE(VERSTR,IBVERSC,2)
- +16 FOR IBI=1:1
- SET IBVERSO=$PIECE(VERSTR,",",IBI)
- if 'IBVERSO
- QUIT
- IF IBVERSIN[(","_IBVERSO_",")
- Begin DoDot:1
- +17 WRITE !!,?5,">>> Currently trying to load RC v"_IBVERS_" but RC v"_IBVERSO_" appears to be already",!,?9,"loaded for this site. The versions should be loaded in date order."
- End DoDot:1
- +18 ;
- +19 ; check if loading a version when the last version has not yet been loaded
- +20 ; all versions before current version, reverse order
- SET VERSTR=","_$$VERSTR(1)_","
- SET VERSTR=$PIECE(VERSTR,IBVERSC,2)
- +21 SET IBVERSO=$PIECE(VERSTR,",",1)
- IF +IBVERSO
- IF IBVERSIN'[(","_IBVERSO_",")
- Begin DoDot:1
- +22 WRITE !!,?5,"*** Currently trying to load RC v"_IBVERS_" but RC v"_IBVERSO_" does not appear to be",!,?9,"loaded for this site. The versions should be loaded in date order."
- +23 WRITE !!,?5,">>> Continue only if there will never be a need to bill events before ",!,?9,$$FMTE^XLFDT(IBVDTC,2)," for this site. If RC v"_IBVERSO_" will be needed for this site then",!,?9,"load it first."
- End DoDot:1
- +24 ;
- +25 QUIT
- +26 ;
- VERSTR(RVRS) ; returns string containing list of all Reasonable Charges versions with charges, separated by ","
- +1 ; RVRS - if set, returns the list of versions in reverse order
- +2 NEW IBI,LINE,IBS,IBR,IBC,IBX
- SET (IBS,IBR,IBC,IBX)=""
- +3 FOR IBI=1:1
- SET LINE=$PIECE($TEXT(VLIST+IBI),";;",2,99)
- if 'LINE
- QUIT
- SET IBS=IBS_IBC_+LINE
- SET IBR=+LINE_IBC_IBR
- SET IBC=","
- +4 SET IBX=IBS
- IF +$GET(RVRS)
- SET IBX=IBR
- +5 QUIT IBX
- +6 ;
- +7 ;
- +8 ;
- +9 ;
- +10 ;
- +11 ; File Names: 'IBRCyymmx.TXT' w/ yymm - year month of version release (except v1)
- +12 ; 'IBRCyymm', file version identifier prefix, from VLIST text version description
- +13 ; x=A-I/F, single character file identifier, from FTYPE text file description
- +14 ;
- FILES(IBFILES,VERS) ; returns array of source Host Files and data for version requested, pass IBFILES by reference
- +1 NEW IBI,LINE,IBTYPE,IBFILE,IBNAME,IBDESC
- SET VERS=+$GET(VERS)
- IF 'VERS
- SET VERS=1
- +2 ;
- +3 ; get requested versions data
- +4 FOR IBI=1:1
- SET LINE=$PIECE($TEXT(VLIST+IBI),";;",2,99)
- if 'LINE
- QUIT
- IF VERS=+LINE
- SET IBTYPE=$PIECE(LINE,U,2)
- SET IBFILE=$PIECE(LINE,U,5)
- QUIT
- +5 ;
- +6 ; get requested versions files
- +7 IF +$GET(IBTYPE)
- FOR IBI=1:1
- SET LINE=$PIECE($TEXT(@("FT"_IBTYPE)+IBI),";;",2,99)
- if LINE=""
- QUIT
- Begin DoDot:1
- +8 SET IBNAME=IBFILE_$PIECE(LINE,":",1)_".TXT"
- SET IBDESC="RC v"_+VERS_" "_$PIECE(LINE,":",2,99)
- +9 SET IBFILES(IBNAME)=IBDESC
- End DoDot:1
- +10 QUIT
- +11 ;
- +12 ;
- +13 ; versions and their critical data, add new versions here
- VLIST ; version ^ file type/version ^ effective date ^ inactive date ^ file prefix
- +1 ;;1.0^1^2990901^3001101^IBRCV
- +2 ;;1.1^1^3001102^3010507^IBRC0011
- +3 ;;1.2^1^3010508^3030428^IBRC0105
- +4 ;;1.4^1^3030429^3031218^IBRC0304
- +5 ;;2.0^2^3031219^3040414^IBRC0312
- +6 ;;2.1^2^3040415^3041231^IBRC0404
- +7 ;;2.3^2^3050101^3050410^IBRC0501
- +8 ;;2.4^2^3050411^3050930^IBRC0504
- +9 ;;2.5^2^3051001^3051231^IBRC0510
- +10 ;;2.6^2^3060101^3060824^IBRC0601
- +11 ;;2.7^2^3060825^3060930^IBRC0608
- +12 ;;2.8^2^3061001^3061231^IBRC0610
- +13 ;;2.9^2^3070101^3070930^IBRC0701
- +14 ;;2.11^2^3071001^3071231^IBRC0710
- +15 ;;3.1^2^3080101^3080930^IBRC0801
- +16 ;;3.2^2^3081001^3081231^IBRC0810
- +17 ;;3.3^2^3090101^3090930^IBRC0901
- +18 ;;3.4^2^3091001^3091231^IBRC0910
- +19 ;;3.5^2^3100101^3100930^IBRC1001
- +20 ;;3.6^2^3101001^3101231^IBRC1010
- +21 ;;3.7^2^3110101^3110930^IBRC1101
- +22 ;;3.8^2^3111001^3111231^IBRC1110
- +23 ;;3.9^2^3120101^3120930^IBRC1201
- +24 ;;3.11^2^3121001^3121231^IBRC1210
- +25 ;;3.12^2^3130101^3130930^IBRC1301
- +26 ;;3.13^2^3131001^3131231^IBRC1310
- +27 ;;3.14^2^3140101^3140930^IBRC1401
- +28 ;;3.15^2^3141001^3141231^IBRC1410
- +29 ;;3.16^2^3150101^3150930^IBRC1501
- +30 ;;3.17^2^3151001^3151231^IBRC1510
- +31 ;;3.18^2^3160101^3160930^IBRC1601
- +32 ;;3.19^2^3161001^3161231^IBRC1610
- +33 ;;3.21^2^3170101^3170930^IBRC1701
- +34 ;;3.22^2^3171001^3171231^IBRC1710
- +35 ;;3.23^2^3180101^3180930^IBRC1801
- +36 ;;3.24^2^3181001^3181231^IBRC1810
- +37 ;;3.25^2^3190101^3190930^IBRC1901
- +38 ;;3.26^2^3191001^3191231^IBRC1910
- +39 ;;3.27^2^3200101^3200930^IBRC2001
- +40 ;;4.21^2^3201001^3201231^IBRC2010
- +41 ;;4.215^2^3210101^3210930^IBRC2101
- +42 ;;4.22^2^3211001^3211231^IBRC2110
- +43 ;;4.225^2^3220101^3220930^IBRC2201
- +44 ;;4.23^2^3221001^3221231^IBRC2210
- +45 ;;4.235^2^3230101^3231231^IBRC2301
- +46 ;;5.24^2^3240101^^IBRC2401
- +47 ;
- FTYPE ; file type/versions and relevant data
- +1 ; file identifier is used with XTMP subscript 'IBCR RC ' and routine label to parse file
- +2 ; file identifier : file name/description ^ file identifier ^ number of columns (for v2+)
- +3 ;
- FT1 ; Reasonable Charge File Type 1 files
- +1 ;;A:Inpatient Facility Charges^A
- +2 ;;B:Inpatient Facility Area Factors^B
- +3 ;;C:Outpatient Facility Charges^C
- +4 ;;D:Outpatient Facility Area Factors^D
- +5 ;;E:Physician Charges E^E
- +6 ;;F:Physician Charges F^F
- +7 ;;G:Physician Charges G^G
- +8 ;;H:Physician Area Factors^H
- +9 ;;I:Physician Unit Area Factors^I
- +10 ;;
- +11 ;
- FT2 ; Reasonable Charges File Type 2 files
- +1 ;;A:Inpatient Facility Charges^A^10
- +2 ;;B:Outpatient Facility Charges^B^14
- +3 ;;C:Professional Charges^C^23
- +4 ;;D:Service Category Codes^D^4
- +5 ;;E:Area Factors^E^41
- +6 ;;F:VA Sites and Zip Codes^F^4
- +7 ;;