- Timestamp:
- Dec 4, 2009, 8:26:01 PM (14 years ago)
- Location:
- FOIAVistA/tag/r
- Files:
-
- 1 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
FOIAVistA/tag/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCRHBRV.m
r628 r636 1 1 IBCRHBRV ;ALB/ARH - RATES: UPLOAD (RC) VERSION FUNCTIONS ; 14-FEB-01 2 ;;2.0;INTEGRATED BILLING;**148,169,245,270,285,298,325,334,355,360,365 ,382,390**;21-MAR-94;Build 22 ;;2.0;INTEGRATED BILLING;**148,169,245,270,285,298,325,334,355,360,365**;21-MAR-94;Build 2 3 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 4 ; 5 ; RC functions related to Version . Update VLIST with new versions. Update FTYPE if new types of files.5 ; RC functions related to Version, most have to be updated when a new version is to be exported 6 6 ; 7 7 SELVERS() ; get version to upload from user 8 N DIR,DIRUT,DTOUT,DUOUT,IBVLIST,IBQUIT,IBVERS,IBI,IBJ,IBX,X,Y 9 ; 10 S IBVLIST=$$VERSTR(),IBQUIT=0,IBVERS=0 11 ; 12 W !!,"Select the version of Reasonable Charges to upload." 13 S DIR("?",1)="Enter the code from the list corresponding to the version of Reasonable Charges" 14 S DIR("?",2)="to upload. There are no version 1.3, 2.2, or 2.10 (ten) RC charges." S DIR("?",3)=" " 15 S DIR("?",4)="Versions: "_IBVLIST S DIR("?",5)=" " S DIR("?")="Enter version number to upload." 16 ; 17 F IBI=1:1 D I +IBQUIT Q 18 . W !!,?5,"Select one of the following:",! 19 . F IBJ=1:1 S IBX=$P(IBVLIST,",",IBJ) Q:'IBX W !,?10,IBX,?20,"Reasonable Charges version ",IBX 20 . ; 21 . W ! S DIR("A")="Enter Version" S DIR(0)="FO^1:5" D ^DIR I $D(DIRUT) S IBQUIT=1 22 . I Y>0,(","_IBVLIST_",")[(","_Y_",") S IBVERS=Y,IBQUIT=1 W " Reasonable Charges version ",IBVERS 23 ; 24 Q IBVERS 8 N DIR,DIRUT,DTOUT,DUOUT,X,Y,IB,IBV,IBVP,IBX 9 S IBV="1.0^1.1^1.2^1.4^2.0^2.1^2.3^2.4^2.5^2.6^2.7^2.8^2.9" ; List of valid version numbers 10 S IBX=0 11 W !!,"Select the version of Reasonable Charges to upload.",! 12 S DIR("?")="Enter a code from the list corresponding to the version of Reasonable Charges to upload. There was no version 1.3 nor 2.2 of Reasonable Charges." 13 S DIR(0)="SO^" 14 F IB=1:1:$L(IBV,U) S IBVP=$P(IBV,U,IB),DIR(0)=DIR(0)_+IBVP_":Reasonable Charges version "_IBVP_";" 15 D ^DIR K DIR S:$L(Y)=1 Y=Y_".0" S IBX=+$S(IBV[Y:Y,1:0) 16 Q IBX 25 17 ; 26 18 VERSION() ; return currently loaded version of RC files (1, 1.1, ...) … … 29 21 ; 30 22 VERSDT(VERS) ; return Effective Date of a version of RC files, either version passed in or currently loaded version 31 N IB I,LINE,IBX S IBX="" S VERS=+$G(VERS) I 'VERS SVERS=$$VERSION32 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)23 N IBX S:'$G(VERS) VERS=$$VERSION 24 S IBX=$S(VERS=1:2990901,VERS=1.1:3001102,VERS=1.2:3010508,VERS=1.4:3030429,VERS=2:3031219,VERS=2.1:3040415,VERS=2.3:3050101,VERS=2.4:3050411,VERS=2.5:3051001,VERS=2.6:3060101,VERS=2.7:3060825,VERS=2.8:3061001,VERS=2.9:3070101,1:"") 33 25 Q IBX 34 26 ; 35 27 VERSEDT(VERS) ; return Inactive Date of a version of RC files, either version passed in or currently loaded version 36 N IB I,LINE,IBX S IBX="" S VERS=+$G(VERS) I 'VERS SVERS=$$VERSION37 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)28 N IBX S:'$G(VERS) VERS=$$VERSION 29 S IBX=$S(VERS=1:3001101,VERS=1.1:3010507,VERS=1.2:3030428,VERS=1.4:3031218,VERS=2:3040414,VERS=2.1:3041231,VERS=2.3:3050410,VERS=2.4:3050930,VERS=2.5:3051231,VERS=2.6:3060824,VERS=2.7:3060930,VERS=2.8:3061231,1:"") 38 30 Q IBX 39 31 ; 40 VERSALL() ; return all RC versions and corresponding effective date 'VERS;EFFDT^VERS;EFFDT^...' 41 N IBI,LINE,IBX,IBC S IBX="",IBC="" 42 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 32 VERSALL() ; returns all RC versions and corresponding effective date 33 N IBX S IBX="1;2990901^1.1;3001102^1.2;3010508^1.4;3030429^2;3031219^2.1;3040415^2.3;3050101^2.4;3050411^2.5;3051001^2.6;3060101^2.7;3060825^2.8;3061001^2.9;3070101" 43 34 Q IBX 44 35 ; 45 VERSEND() ; return all RC versions and corresponding inactive date 'VERS;INACTIVE DT^VERS;INACTIVE DT^...' 46 N IBI,LINE,IBX,IBC S IBX="",IBC="" 47 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 36 VERSEND() ; returns all RC versions and corresponding inactive dates 37 N IBX S IBX="1;3001101^1.1;3010507^1.2;3030428^1.4;3031218^2;3040414^2.1;3041231^2.3;3050410^2.4;3050930^2.5;3051231^2.6;3060824^2.7;3060930^2.8;3061231" 48 38 Q IBX 39 ; 49 40 ; 50 41 VERSITE(SITE) ; returns the list of versions loaded for a particular site 51 42 ; *** uses 99201 in the RC PHYSICIAN set to check which versions/dates are loaded 52 43 ; *** so 99201 must have a pro charge in all versions, if not it must be replaced with an item that does 53 N IBCS,IBXRF,IBITM,IBVERS,IBCSFN,IBI,IBV,IBX,IBY ,IBC44 N IBCS,IBXRF,IBITM,IBVERS,IBCSFN,IBI,IBV,IBX,IBY S IBX="" 54 45 S IBVERS=$$VERSALL,IBITM=99201 55 46 ; … … 58 49 . S IBCSFN=$O(^IBE(363.1,"B",IBCS,0)) Q:'IBCSFN S IBXRF="AIVDTS"_IBCSFN 59 50 . F IBI=1:1 S IBV=$P(IBVERS,U,IBI) Q:'IBV I $O(^IBA(363.2,IBXRF,IBITM,-$P(IBV,";",2),0)) S IBY(+IBV)="" 51 S IBV="" F S IBV=$O(IBY(IBV)) Q:'IBV S IBX=IBX_IBV_"," 60 52 ; 61 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="," 62 ; 53 I $E(IBX,$L(IBX))="," S IBX=$E(IBX,1,$L(IBX)-1) 63 54 Q IBX 64 55 ; … … 71 62 ; 72 63 MSGVERS(SITE) ; check if versions are being loaded in the correct order, should be loaded in date order 64 ; displays messages to the user: 73 65 ; - if loading a version that has already been loaded for the site 74 66 ; - if loading a version when any future versions have already been loaded for the site … … 76 68 ; *** uses 99201 in the RC PHYSICIAN set to check which versions/dates are loaded 77 69 ; *** so 99201 must have a pro charge in all versions, if not it must be replaced with an item that does 78 N IBVERS,IBVDTC,IBVERSIN,IBVERS C,IBVERSO,IBI,VERSTRQ:'$G(SITE)70 N IBVERS,IBVDTC,IBVERSIN,IBVERSO Q:'$G(SITE) 79 71 ; 80 S IBVERS=$$VERSION Q:'IBVERS S IBVDTC=$$VERSDT,IBVERSIN=","_$$VERSITE(SITE)_"," ,IBVERSC=","_IBVERS_","72 S IBVERS=$$VERSION Q:'IBVERS S IBVDTC=$$VERSDT,IBVERSIN=","_$$VERSITE(SITE)_"," 81 73 ; 82 74 ; check if loading a version that has already been loaded 83 I IBVERSIN[ IBVERSCD75 I IBVERSIN[(","_IBVERS_",") D 84 76 . W !!,?5,"*** It appears version RC v",IBVERS," has already been loaded for this site ***" 85 77 ; 86 78 ; check if loading a version when any future versions have already been loaded 87 S VERSTR=","_$$VERSTR()_",",VERSTR=$P(VERSTR,IBVERSC,2) ; all versions after current version88 F IBI=1:1 S IBVERSO=$P(VERSTR,",",IBI) Q:'IBVERSO I IBVERSIN[(","_IBVERSO_",")D89 . 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."79 F IBVERSO=1,1.1,1.2,1.4,2,2.1,2.3,2.4,2.5,2.6,2.7,2.8,2.9 I IBVERSO>IBVERS D 80 . I IBVERSIN[(","_IBVERSO_",") D 81 .. 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." 90 82 ; 91 83 ; check if loading a version when the last version has not yet been loaded 92 S VERSTR=","_$$VERSTR(1)_",",VERSTR=$P(VERSTR,IBVERSC,2) ; all versions before current version, reverse order93 S IBVERSO=$P(VERSTR,",",1) I +IBVERSO,IBVERSIN'[(","_IBVERSO_",") D94 . 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."95 . 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."84 F IBVERSO=2.9,2.8,2.7,2.6,2.5,2.4,2.3,2.1,2,1.4,1.2,1.1,1 I IBVERS>IBVERSO D Q 85 . I IBVERSIN'[(","_IBVERSO_",") D 86 .. 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." 87 .. 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." 96 88 ; 97 89 Q 98 90 ; 99 VERSTR(RVRS) ; returns string containing list of all Reasonable Charges versions with charges, separated by "," 100 ; RVRS - if set, returns the list of versions in reverse order 101 N IBI,LINE,IBS,IBR,IBC,IBX S (IBS,IBR,IBC,IBX)="" 102 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="," 103 S IBX=IBS I +$G(RVRS) S IBX=IBR 104 Q IBX 91 FILES(IBFILES,VERS) ; source Host file name, description, and routine label that parses the file 92 ; the subscript used for the file in XTMP is 'IBCR RC '_X w/ X=the routine label that parses the file 105 93 ; 94 I $G(VERS)=1.1 G FBREAL 95 I $G(VERS)=1.2 G FCREAL 96 I $G(VERS)=1.4 G FDREAL 97 I $G(VERS)=2 G FEREAL 98 I $G(VERS)=2.1 G FFREAL 99 I $G(VERS)=2.3 G FGREAL 100 I $G(VERS)=2.4 G FHREAL 101 I $G(VERS)=2.5 G FIREAL^IBCRHBV1 102 I $G(VERS)=2.6 G FJREAL^IBCRHBV1 103 I $G(VERS)=2.7 G FKREAL^IBCRHBV1 104 I $G(VERS)=2.8 G FLREAL^IBCRHBV1 105 I $G(VERS)=2.9 G FMREAL^IBCRHBV1 106 106 ; 107 ; 108 ; 109 ; 110 ; 111 ; 112 ; File Names: 'IBRCyymmx.TXT' w/ yymm - year month of version release (except v1) 113 ; 'IBRCyymm', file version identifier prefix, from VLIST text version description 114 ; x=A-I/F, single character file identifier, from FTYPE text file description 115 ; 116 FILES(IBFILES,VERS) ; returns array of source Host Files and data for version requested, pass IBFILES by reference 117 N IBI,LINE,IBTYPE,IBFILE,IBNAME,IBDESC S VERS=+$G(VERS) I 'VERS S VERS=1 118 ; 119 ; get requested versions data 120 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 121 ; 122 ; get requested versions files 123 I +$G(IBTYPE) F IBI=1:1 S LINE=$P($T(@("FT"_IBTYPE)+IBI),";;",2,99) Q:LINE="" D 124 . S IBNAME=IBFILE_$P(LINE,":",1)_".TXT",IBDESC="RC v"_+VERS_" "_$P(LINE,":",2,99) 125 . S IBFILES(IBNAME)=IBDESC 107 FREAL S IBFILES("IBRCVA.TXT")="RC v1 Inpatient Facility Charges^A" 108 S IBFILES("IBRCVB.TXT")="RC v1 Inpatient Facility Area Factors^B" 109 S IBFILES("IBRCVC.TXT")="RC v1 Outpatient Facility Charges^C" 110 S IBFILES("IBRCVD.TXT")="RC v1 Outpatient Facility Area Factors^D" 111 S IBFILES("IBRCVE.TXT")="RC v1 Physician Charges E^E" 112 S IBFILES("IBRCVF.TXT")="RC v1 Physician Charges F^F" 113 S IBFILES("IBRCVG.TXT")="RC v1 Physician Charges G^G" 114 S IBFILES("IBRCVH.TXT")="RC v1 Physician Area Factors^H" 115 S IBFILES("IBRCVI.TXT")="RC v1 Physician Unit Area Factors^I" 126 116 Q 127 117 ; 118 FBREAL S IBFILES("IBRC0011A.TXT")="RC v1.1 Inpatient Facility Charges^A" 119 S IBFILES("IBRC0011B.TXT")="RC v1.1 Inpatient Facility Area Factors^B" 120 S IBFILES("IBRC0011C.TXT")="RC v1.1 Outpatient Facility Charges^C" 121 S IBFILES("IBRC0011D.TXT")="RC v1.1 Outpatient Facility Area Factors^D" 122 S IBFILES("IBRC0011E.TXT")="RC v1.1 Physician Charges E^E" 123 S IBFILES("IBRC0011F.TXT")="RC v1.1 Physician Charges F^F" 124 S IBFILES("IBRC0011G.TXT")="RC v1.1 Physician Charges G^G" 125 S IBFILES("IBRC0011H.TXT")="RC v1.1 Physician Area Factors^H" 126 S IBFILES("IBRC0011I.TXT")="RC v1.1 Physician Unit Area Factors^I" 127 Q 128 128 ; 129 ; versions and their critical data, add new versions here 130 VLIST ; version ^ file type/version ^ effective date ^ inactive date ^ file prefix 131 ;;1.0^1^2990901^3001101^IBRCV 132 ;;1.1^1^3001102^3010507^IBRC0011 133 ;;1.2^1^3010508^3030428^IBRC0105 134 ;;1.4^1^3030429^3031218^IBRC0304 135 ;;2.0^2^3031219^3040414^IBRC0312 136 ;;2.1^2^3040415^3041231^IBRC0404 137 ;;2.3^2^3050101^3050410^IBRC0501 138 ;;2.4^2^3050411^3050930^IBRC0504 139 ;;2.5^2^3051001^3051231^IBRC0510 140 ;;2.6^2^3060101^3060824^IBRC0601 141 ;;2.7^2^3060825^3060930^IBRC0608 142 ;;2.8^2^3061001^3061231^IBRC0610 143 ;;2.9^2^3070101^3070930^IBRC0701 144 ;;2.11^2^3071001^3071231^IBRC0710 145 ;;3.1^2^3080101^^IBRC0801 146 ;; 147 ; 148 ; 149 ; 150 ; 151 ; 152 ; 153 ; 154 FTYPE ; file type/versions and relevant data 155 ; file identifer is used with XTMP subscript 'IBCR RC ' and routine label to parse file 156 ; file identifier : file name/description ^ file identifier ^ number of columns (for v2+) 129 FCREAL S IBFILES("IBRC0105A.TXT")="RC v1.2 Inpatient Facility Charges^A" 130 S IBFILES("IBRC0105B.TXT")="RC v1.2 Inpatient Facility Area Factors^B" 131 S IBFILES("IBRC0105C.TXT")="RC v1.2 Outpatient Facility Charges^C" 132 S IBFILES("IBRC0105D.TXT")="RC v1.2 Outpatient Facility Area Factors^D" 133 S IBFILES("IBRC0105E.TXT")="RC v1.2 Physician Charges E^E" 134 S IBFILES("IBRC0105F.TXT")="RC v1.2 Physician Charges F^F" 135 S IBFILES("IBRC0105G.TXT")="RC v1.2 Physician Charges G^G" 136 S IBFILES("IBRC0105H.TXT")="RC v1.2 Physician Area Factors^H" 137 S IBFILES("IBRC0105I.TXT")="RC v1.2 Physician Unit Area Factors^I" 138 Q 157 139 ; 158 FT1 ; Reasonable Charge File Type 1 files 159 ;;A:Inpatient Facility Charges^A 160 ;;B:Inpatient Facility Area Factors^B 161 ;;C:Outpatient Facility Charges^C 162 ;;D:Outpatient Facility Area Factors^D 163 ;;E:Physician Charges E^E 164 ;;F:Physician Charges F^F 165 ;;G:Physician Charges G^G 166 ;;H:Physician Area Factors^H 167 ;;I:Physician Unit Area Factors^I 168 ;; 140 FDREAL S IBFILES("IBRC0304A.TXT")="RC v1.4 Inpatient Facility Charges^A" 141 S IBFILES("IBRC0304B.TXT")="RC v1.4 Inpatient Facility Area Factors^B" 142 S IBFILES("IBRC0304C.TXT")="RC v1.4 Outpatient Facility Charges^C" 143 S IBFILES("IBRC0304D.TXT")="RC v1.4 Outpatient Facility Area Factors^D" 144 S IBFILES("IBRC0304E.TXT")="RC v1.4 Physician Charges E^E" 145 S IBFILES("IBRC0304F.TXT")="RC v1.4 Physician Charges F^F" 146 S IBFILES("IBRC0304G.TXT")="RC v1.4 Physician Charges G^G" 147 S IBFILES("IBRC0304H.TXT")="RC v1.4 Physician Area Factors^H" 148 S IBFILES("IBRC0304I.TXT")="RC v1.4 Physician Unit Area Factors^I" 149 Q 169 150 ; 170 FT2 ; Reasonable Charges File Type 2 files 171 ;;A:Inpatient Facility Charges^A^10 172 ;;B:Outpatient Facility Charges^B^14 173 ;;C:Professional Charges^C^23 174 ;;D:Service Category Codes^D^4 175 ;;E:Area Factors^E^41 176 ;;F:VA Sites and Zip Codes^F^4 177 ;; 151 FEREAL S IBFILES("IBRC0312A.TXT")="RC v2.0 Inpatient Facility Charges^A^10" 152 S IBFILES("IBRC0312B.TXT")="RC v2.0 Outpatient Facility Charges^B^14" 153 S IBFILES("IBRC0312C.TXT")="RC v2.0 Professional Charges^C^23" 154 S IBFILES("IBRC0312D.TXT")="RC v2.0 Service Category Codes^D^4" 155 S IBFILES("IBRC0312E.TXT")="RC v2.0 Area Factors^E^41" 156 S IBFILES("IBRC0312F.TXT")="RC v2.0 VA Sites and Zip Codes^F^4" 157 Q 158 ; 159 FFREAL S IBFILES("IBRC0404A.TXT")="RC v2.1 Inpatient Facility Charges^A^10" 160 S IBFILES("IBRC0404B.TXT")="RC v2.1 Outpatient Facility Charges^B^14" 161 S IBFILES("IBRC0404C.TXT")="RC v2.1 Professional Charges^C^23" 162 S IBFILES("IBRC0404D.TXT")="RC v2.1 Service Category Codes^D^4" 163 S IBFILES("IBRC0404E.TXT")="RC v2.1 Area Factors^E^41" 164 S IBFILES("IBRC0404F.TXT")="RC v2.1 VA Sites and Zip Codes^F^4" 165 Q 166 ; 167 FGREAL S IBFILES("IBRC0501A.TXT")="RC v2.3 Inpatient Facility Charges^A^10" 168 S IBFILES("IBRC0501B.TXT")="RC v2.3 Outpatient Facility Charges^B^14" 169 S IBFILES("IBRC0501C.TXT")="RC v2.3 Professional Charges^C^23" 170 S IBFILES("IBRC0501D.TXT")="RC v2.3 Service Category Codes^D^4" 171 S IBFILES("IBRC0501E.TXT")="RC v2.3 Area Factors^E^41" 172 S IBFILES("IBRC0501F.TXT")="RC v2.3 VA Sites and Zip Codes^F^4" 173 Q 174 ; 175 FHREAL S IBFILES("IBRC0504A.TXT")="RC v2.4 Inpatient Facility Charges^A^10" 176 S IBFILES("IBRC0504B.TXT")="RC v2.4 Outpatient Facility Charges^B^14" 177 S IBFILES("IBRC0504C.TXT")="RC v2.4 Professional Charges^C^23" 178 S IBFILES("IBRC0504D.TXT")="RC v2.4 Service Category Codes^D^4" 179 S IBFILES("IBRC0504E.TXT")="RC v2.4 Area Factors^E^41" 180 S IBFILES("IBRC0504F.TXT")="RC v2.4 VA Sites and Zip Codes^F^4" 181 Q
Note:
See TracChangeset
for help on using the changeset viewer.