Produced by Araxis Merge on 8/4/2017 8:56:58 AM Eastern Daylight Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.
| # | Location | File | Last Modified |
|---|---|---|---|
| 1 | IB_2.0_577.zip | TAS+eBill+SDD+US1166+v1.02.docx | Tue Aug 1 17:53:50 2017 UTC |
| 2 | IB_2.0_577.zip | TAS+eBill+SDD+US1166+v1.02.docx | Tue Aug 1 19:26:00 2017 UTC |
| Description | Between Files 1 and 2 |
|
|---|---|---|
| Text Blocks | Lines | |
| Unchanged | 1 | 1554 |
| Changed | 0 | 0 |
| Inserted | 0 | 0 |
| Removed | 0 | 0 |
| Whitespace | |
|---|---|
| Character case | Differences in character case are significant |
| Line endings | Differences in line endings (CR and LF characters) are ignored |
| CR/LF characters | Not shown in the comparison detail |
No regular expressions were active.
| 1 | MCCF EDI T AS US1166 | |
| 2 | System Des ign Docume nt | |
| 3 | IB*2.0*577 | |
| 4 | ||
| 5 | ||
| 6 | ||
| 7 | ||
| 8 | Department of Vetera ns Affairs | |
| 9 | May 2017 | |
| 10 | Version 1. 02 | |
| 11 | User Story Number: U S1166 | |
| 12 | User Story Name: Pri nt NDC Num ber on UB0 4 | |
| 13 | Resolution – Data De sign | |
| 14 | Modify/add a couple of lines o f code in ^IBCEF22 t o format t he Quantit y with up to 3 decim al places. Note tha t US11 add s the Unit of Measur e to the U B-04 and t he new log ic per US1 1is highli ghted. Th is SDD mod ifies this code and is highlig hted in ye llow in th e “Modifie d Logic” s ection. | |
| 15 | ||
| 16 | Routines | |
| 17 | Activities | |
| 18 | Routine Na me | |
| 19 | IBCEF22 | |
| 20 | Enhancemen t Category | |
| 21 | New | |
| 22 | Modify | |
| 23 | Delete | |
| 24 | No Change | |
| 25 | RTM | |
| 26 | ||
| 27 | Related Op tions | |
| 28 | None | |
| 29 | Related Ro utines | |
| 30 | Routines “ Called By” | |
| 31 | Routines “ Called” | |
| 32 | ||
| 33 | ||
| 34 | ||
| 35 | ||
| 36 | Data Dicti onary (DD) Reference s | |
| 37 | “Units/Bas is of Meas urement” f ield [#399 .0304, 52] | |
| 38 | “NDC Numbe r” field [ #399.0304, 53] | |
| 39 | “Quantity” field [# 399.0304, 54] | |
| 40 | Related Pr otocols | |
| 41 | None | |
| 42 | Related In tegration Control Re gistration s (ICRs) | |
| 43 | None | |
| 44 | Data Passi ng | |
| 45 | Input | |
| 46 | Output Re ference | |
| 47 | Both | |
| 48 | Global Re ference | |
| 49 | Local | |
| 50 | Input Attr ibute Name and Defin ition | |
| 51 | Name: | |
| 52 | Definition : | |
| 53 | Output Att ribute Nam e and Defi nition | |
| 54 | Name: | |
| 55 | Definition : | |
| 56 | Current Lo gic | |
| 57 | IBCEF22 ;A LB/TMP - F ORMATTER S PECIFIC BI LL FUNCTIO NS ;06-FEB -96 | |
| 58 | ;; 2.0;INTEGR ATED BILLI NG;**51,13 7,135,155, 309,349,38 9,432,488, 516**;21-M AR-94;Buil d 123 | |
| 59 | ;; Per VA Dir ective 640 2, this ro utine shou ld not be modified. | |
| 60 | ; | |
| 61 | ; OVERFLOW FROM ROUTI NE IBCEF2 | |
| 62 | HOS(IBIFN) ; Extract rev codes for episo de billed on a UB-04 into IBXD ATA | |
| 63 | ; IBIFN = bi ll ien | |
| 64 | ; Format: IB XDATA(n) = | |
| 65 | ; rev cd pt r ^ CPT CO DE ptr ^ u nit chg ^ units ^ to t charge | |
| 66 | ; ^ tot u ncov ^ FL4 9 value | |
| 67 | ; ^ ien o f rev code multiple entry(s) ( separated by ";") | |
| 68 | ; ^ modif iers speci fic to rev code/proc (separate d by ",") | |
| 69 | ; ^ rev c ode date, if it can be determi ned by a c orrespondi ng proc | |
| 70 | ; ^ NDC f rom "CP" n ode of cla im ^ Units /Quantity from "CP" node | |
| 71 | ; ^ Units /Basis of Measuremen t for Drug s | |
| 72 | ; | |
| 73 | ; Also Ret urns IBXDA TA(IBI,"CO B",COB,m) with COB d ata for ea ch line | |
| 74 | ; item found in a n accepted EOB for t he bill an d = the re ference | |
| 75 | ; lin e in the f irst '^' p iece follo wed by the '0' node of file | |
| 76 | ; 361.1 15 (LINE L EVEL ADJUS TMENTS) | |
| 77 | ; COB = COB seq # of adjus tment's in s co, m = seq # | |
| 78 | ; -- AND -- | |
| 79 | ; IBXDATA (IBI,"COB" ,COB,m,z,p )= | |
| 80 | ; the '0' no de for eac h subordin ate entry of file | |
| 81 | ; 361.11511 (REASONS) (Only firs t 3 pieces for 837) | |
| 82 | ; z = group code , sometime s preceede d by a spa ce p = s eq # | |
| 83 | ; | |
| 84 | ; -- AND -- | |
| 85 | ; IBXDATA (n,"CPLNK" ) = soft l ink to cor responding entry in PROCEDURES multiple of file 39 9 | |
| 86 | ; | |
| 87 | … | |
| 88 | D SPLIT ; 4 88 ; baa | |
| 89 | ; | |
| 90 | ; Loop throu gh IBX1 an d build th e array IB XDATA. Eve rything in the | |
| 91 | ; array IBXD ATA comes from the a rray IBX1. | |
| 92 | ; | |
| 93 | S IBS="",IBL N=0 | |
| 94 | F S IBS=$O( IBX1(IBS)) Q:IBS="" S IBPO=0 F S IBPO= $O(IBX1(IB S,IBPO)) Q :'IBPO S IBSS="" F S IBSS=$O (IBX1(IBS, IBPO,IBSS) ) | |
| 95 | Q:IBSS="" D | |
| 96 | . S IBX=$G(I BX1(IBS,IB PO,IBSS,1) ),IBZ=$G(I BX1(IBS,IB PO,IBSS,2) ) | |
| 97 | . S IBLN=$G( IBLN)+1,IB XDATA(IBLN )=$P(IBX,U )_U_$P(IBZ ,U,6)_U_$P (IBZ,U,2)_ U_+IBX1(IB S,IBPO,IBS S)_U_+$P(I BX1(IBS,IB PO,IBSS),U , | |
| 98 | 2),$P(IBXD ATA(IBLN), U,10)=$G(I BX1(IBS,IB PO,IBSS,"D T")) | |
| 99 | . S $P(IBXDA TA(IBLN),U ,6)=$P(IBZ ,U,9),$P(I BXDATA(IBL N),U,7)=$P (IBZ,U,13) ,$P(IBXDAT A(IBLN),U, 8)=$G(IBX1 (IBS,IBPO, IBSS,"IEN" ) | |
| 100 | ),$P(IBXDA TA(IBLN),U ,9)=$P($P( IBSS,U,3), ",",1,2) | |
| 101 | . S IBXDATA( IBLN,"CPLN K")=$$RC2C P(IBIFN,$P ($P(IBXDAT A(IBLN),U, 8),";")) | |
| 102 | . ; | |
| 103 | . ; MRD;IB*2 .0*516 - A dded NDC a nd Units t o line lev el of clai m. | |
| 104 | . ;I IBXDATA (IBLN,"CPL NK") S $P( IBXDATA(IB LN),U,11,1 2)=$TR($P( $G(^DGCR(3 99,IBIFN," CP",IBXDAT A(IBLN,"CP LNK"),1)), U,7,8),"-" ) | |
| 105 | . ; VAD;IB*2 .0*??? – A dded Unit/ Basis of M easurement to line l evel of cl aim. | |
| 106 | . I IBXDATA( IBLN,"CPLN K") S $P(I BXDATA(IBL N),U,11,13 )=$TR($P($ G(^DGCR(39 9,IBIFN,"C P",IBXDATA (IBLN,"CPL NK"),1)),U ,7,9),"-") | |
| 107 | . ; | |
| 108 | . ; Extract line lev C OB data fo r sec or t ert bill | |
| 109 | . I $$COBN^I BCEF(IBIFN )>1 D COBL INE^IBCEU6 (IBIFN,IBL N,.IBXDATA ,,.IBXTRA) I $D(IBXT RA) D COMB O^IBCEU2(. IBXDATA,.I BXTRA,1) ; Handle bun dled/unbun dled | |
| 110 | ; | |
| 111 | … | |
| 112 | ||
| 113 | Modified L ogic (Chan ges are hi ghlighted in yellow) | |
| 114 | IBCEF22 ;A LB/TMP - F ORMATTER S PECIFIC BI LL FUNCTIO NS ;06-FEB -96 | |
| 115 | ;; 2.0;INTEGR ATED BILLI NG;**51,13 7,135,155, 309,349,38 9,432,488, 516,577**; 21-MAR-94; Build 123 | |
| 116 | ;; Per VA Dir ective 640 2, this ro utine shou ld not be modified. | |
| 117 | ; | |
| 118 | ; OVERFLOW FROM ROUTI NE IBCEF2 | |
| 119 | HOS(IBIFN) ; Extract rev codes for episo de billed on a UB-04 into IBXD ATA | |
| 120 | ; IBIFN = bi ll ien | |
| 121 | ; Format: IB XDATA(n) = | |
| 122 | ; rev cd pt r ^ CPT CO DE ptr ^ u nit chg ^ units ^ to t charge | |
| 123 | ; ^ tot u ncov ^ FL4 9 value | |
| 124 | ; ^ ien o f rev code multiple entry(s) ( separated by ";") | |
| 125 | ; ^ modif iers speci fic to rev code/proc (separate d by ",") | |
| 126 | ; ^ rev c ode date, if it can be determi ned by a c orrespondi ng proc | |
| 127 | ; ^ NDC f rom "CP" n ode of cla im ^ Units /Quantity from "CP" node ;vd/ IB*2*577 | |
| 128 | ; ^ Units /Basis of Measuremen t for Drug s - vd/IB *2*577 | |
| 129 | ; | |
| 130 | ; Also Ret urns IBXDA TA(IBI,"CO B",COB,m) with COB d ata for ea ch line | |
| 131 | ; item found in a n accepted EOB for t he bill an d = the re ference | |
| 132 | ; lin e in the f irst '^' p iece follo wed by the '0' node of file | |
| 133 | ; 361.1 15 (LINE L EVEL ADJUS TMENTS) | |
| 134 | ; COB = COB seq # of adjus tment's in s co, m = seq # | |
| 135 | ; -- AND -- | |
| 136 | ; IBXDATA (IBI,"COB" ,COB,m,z,p )= | |
| 137 | ; the '0' no de for eac h subordin ate entry of file | |
| 138 | ; 361.11511 (REASONS) (Only firs t 3 pieces for 837) | |
| 139 | ; z = group code , sometime s preceede d by a spa ce p = s eq # | |
| 140 | ; | |
| 141 | ; -- AND -- | |
| 142 | ; IBXDATA (n,"CPLNK" ) = soft l ink to cor responding entry in PROCEDURES multiple of file 39 9 | |
| 143 | ; | |
| 144 | … | |
| 145 | ; | |
| 146 | D SPLIT ; 4 88 ; baa | |
| 147 | ; | |
| 148 | ; Loop throu gh IBX1 an d build th e array IB XDATA. Eve rything in the | |
| 149 | ; array IBXD ATA comes from the a rray IBX1. | |
| 150 | ; | |
| 151 | S IBS="",IBL N=0 | |
| 152 | F S IBS=$O( IBX1(IBS)) Q:IBS="" S IBPO=0 F S IBPO= $O(IBX1(IB S,IBPO)) Q :'IBPO S IBSS="" F S IBSS=$O (IBX1(IBS, IBPO,IBSS) ) | |
| 153 | Q:IBSS="" D | |
| 154 | . S IBX=$G(I BX1(IBS,IB PO,IBSS,1) ),IBZ=$G(I BX1(IBS,IB PO,IBSS,2) ) | |
| 155 | . S IBLN=$G( IBLN)+1,IB XDATA(IBLN )=$P(IBX,U )_U_$P(IBZ ,U,6)_U_$P (IBZ,U,2)_ U_+IBX1(IB S,IBPO,IBS S)_U_+$P(I BX1(IBS,IB PO,IBSS),U , | |
| 156 | 2),$P(IBXD ATA(IBLN), U,10)=$G(I BX1(IBS,IB PO,IBSS,"D T")) | |
| 157 | . S $P(IBXDA TA(IBLN),U ,6)=$P(IBZ ,U,9),$P(I BXDATA(IBL N),U,7)=$P (IBZ,U,13) ,$P(IBXDAT A(IBLN),U, 8)=$G(IBX1 (IBS,IBPO, IBSS,"IEN" ) | |
| 158 | ),$P(IBXDA TA(IBLN),U ,9)=$P($P( IBSS,U,3), ",",1,2) | |
| 159 | . S IBXDATA( IBLN,"CPLN K")=$$RC2C P(IBIFN,$P ($P(IBXDAT A(IBLN),U, 8),";")) | |
| 160 | . ; | |
| 161 | . ; MRD;IB*2 .0*516 - A dded NDC a nd Units t o line lev el of clai m. | |
| 162 | . ;I IBXDATA (IBLN,"CPL NK") S $P( IBXDATA(IB LN),U,11,1 2)=$TR($P( $G(^DGCR(3 99,IBIFN," CP",IBXDAT A(IBLN,"CP LNK"),1)), U,7,8),"-" ) | |
| 163 | . ; VAD;IB*2 .0*577 – A dded Unit/ Basis of M easurement to line l evel of cl aim. | |
| 164 | . ; VD;IB*2. 0*577 - Ad ded DO in order to f ormat the quantity w ith up to 3 decimals (no decim als if who le #) | |
| 165 | . ;I IBXDATA (IBLN,"CPL NK") S $P( IBXDATA(IB LN),U,11,1 3)=$TR($P( $G(^DGCR(3 99,IBIFN," CP",IBXDAT A(IBLN,"CP LNK"),1)), U,7,9),"-" ) ;VD;IB* 2.0*577 ‘; ’ | |
| 166 | . I IBXDATA( IBLN,"CPLN K") D | |
| 167 | . . S $P(IBX DATA(IBLN) ,U,11,13)= $TR($P($G( ^DGCR(399, IBIFN,"CP" ,IBXDATA(I BLN,"CPLNK "),1)),U,7 ,9),"-") ;VD;IB*2.0 *577 | |
| 168 | . . I +$P(IB XDATA(IBLN ),U,12) S $P(IBXDATA (IBLN),U,1 2)=$S($P(I BXDATA(IBL N),U,12)#1 :+$J($P(IB XDATA(IBLN ),U,12),0, 3),1:$P(IB XDATA(IBLN ),U,12)) | |
| 169 | . ; | |
| 170 | . ; Extract line lev C OB data fo r sec or t ert bill | |
| 171 | . I $$COBN^I BCEF(IBIFN )>1 D COBL INE^IBCEU6 (IBIFN,IBL N,.IBXDATA ,,.IBXTRA) I $D(IBXT RA) D COMB O^IBCEU2(. IBXDATA,.I BXTRA,1) ; Handle bun dled/unbun dled | |
| 172 | ; | |
| 173 | … | |
| 174 | ||
| 175 | The IBCF33 routine n eeds to be modified to put the Unit/Basi s of Measu re (in add ition to “ Units/Qty” and “NDC# ”) into gl obal ^TMP( $J,"IBC-RC "), which is needed by the FOR MAT CODE f or the REV CODE DESC RIPTION fi eld in for m UB-04: | |
| 176 | Routines | |
| 177 | Activities | |
| 178 | Routine Na me | |
| 179 | IBCF33 | |
| 180 | Enhancemen t Category | |
| 181 | New | |
| 182 | Modify | |
| 183 | Delete | |
| 184 | No Change | |
| 185 | RTM | |
| 186 | ||
| 187 | Related Op tions | |
| 188 | None | |
| 189 | Related Ro utines | |
| 190 | Routines “ Called By” | |
| 191 | Routines “ Called” | |
| 192 | ||
| 193 | ||
| 194 | ||
| 195 | ||
| 196 | Data Dicti onary (DD) Reference s | |
| 197 | “Units/Bas is of Meas urement” f ield [#399 .0304, 52] | |
| 198 | “NDC Numbe r” field [ #399.0304, 53] | |
| 199 | “Quantity” field [# 399.0304, 54] | |
| 200 | Related Pr otocols | |
| 201 | None | |
| 202 | Related In tegration Control Re gistration s (ICRs) | |
| 203 | None | |
| 204 | Data Passi ng | |
| 205 | Input | |
| 206 | Output Re ference | |
| 207 | Both | |
| 208 | Global Re ference | |
| 209 | Local | |
| 210 | Input Attr ibute Name and Defin ition | |
| 211 | Name: | |
| 212 | Definition : | |
| 213 | Output Att ribute Nam e and Defi nition | |
| 214 | Name: | |
| 215 | Definition : | |
| 216 | Current Lo gic | |
| 217 | IBCF33 ;AL B/ARH - UB -04 CMS-14 50 (GATHER CODES) ;2 5-AUG-1993 | |
| 218 | ;;2.0;INT EGRATED BI LLING;**52 ,80,109,51 ,230,349** ;21-MAR-94 ;Build 46 | |
| 219 | ;;Per VHA Directive 2004-038, this rout ine should not be mo dified. | |
| 220 | ; | |
| 221 | ;IBIFN re quired | |
| 222 | ; | |
| 223 | ; Not all free text prints in these blo cks as of MRA/EDI - only print | |
| 224 | ; REVEN UE CODES a nd associa ted data, Rx's and p rosthetics | |
| 225 | ; and l ast line t o indicate multiple pages | |
| 226 | N IBI,IBJ ,IBCU2,IBC OL,IBSTATE ,IBCBILL,I BINPAT,IBX ,IBY,Z,IBZ ,IBLPG | |
| 227 | S IBLINES =22,IBCU2= $G(^DGCR(3 99,IBIFN," U2")),IBCO L=1,IBNOCO M=0 | |
| 228 | K IBXSAVE ("RX-UB-04 "),IBXSAVE ("PROS-UB- 04") | |
| 229 | D HOS^IBC EF22(IBIFN ) | |
| 230 | ; | |
| 231 | I $$TXMT^ IBCEF4(IBI FN) S IBNO COM=1 | |
| 232 | S Z="",IB NOCHG=0 | |
| 233 | ; Add tot al line as last entr y, if not already th ere | |
| 234 | ;S IBLCT= $O(IBXDATA (""),-1) | |
| 235 | ;I IBLCT, $P(IBXDATA (IBLCT),U) '="001" S IBXDATA(IB LCT+1)="00 1" | |
| 236 | ;S IBLCT= 0 | |
| 237 | S IBLPG=( $O(IBXDATA (""),-1)+$ O(IBXSAVE( "RX-UB-04" ,""),-1)+$ O(IBXSAVE( "PROS-UB-0 4",""),-1) )/22,IBLPG =IBLPG\1+$ S($P(IBLPG ,".",2):1, 1:0) | |
| 238 | F S Z=$O (IBXDATA(Z )) Q:'Z D | |
| 239 | . N IBZ1 | |
| 240 | . ;I $P(I BXDATA(Z), U)="001",' $O(IBXDATA (Z)) S IBZ ="001",$P( IBZ,U,4)=$ P(IBCBCOMM ,U,1),IBDA =0 S:IBNOC HG $P(IBZ, U,9)=$G(IB NOCHG) S I BXDATA(Z)= IBZ D SET1 Q | |
| 241 | . ;Get mo difiers | |
| 242 | . S IBZ1= $G(^DGCR(3 99,IBIFN," RC",+$P(IB XDATA(Z),U ,8),0)),IB MOD="" | |
| 243 | . I $P(IB Z1,U,6),$S ($P(IBZ1,U ,10)=4:$P( IBZ1,U,11) ,1:'$P(IBZ 1,U,10)) S $P(IBXDAT A(Z),U,9)= $$MOD(IBZ1 ,IBIFN) | |
| 244 | . S IBZ=$ P(IBXDATA( Z),U)_U_$P (IBXDATA(Z ),U,3,5)_" ^^"_$P(IBX DATA(Z),U, 2),$P(IBZ, U,9)=$P(IB XDATA(Z),U ,6),$P(IBZ ,U,13)=$P( IBXDATA(Z) ,U,7),$P(I BZ,U,10)=$ P(IBXDATA( Z),U,9),$P (IBZ,U,14) =$P(IBXDAT A(Z),U,10) | |
| 245 | . I IBZ S IBNOCHG=I BNOCHG+$P( IBXDATA(Z) ,U,6),IBDA =$P(IBXDAT A(Z),U,8) D SET1 | |
| 246 | . ;S IBLC T=IBLCT+1 | |
| 247 | I $D(IBXS AVE("RX-UB -04"))!$D( IBXSAVE("P ROS-UB-04" )) D | |
| 248 | . N Z | |
| 249 | . S Z=0 F S Z=$O(I BXSAVE("RX -UB-04",Z) ) Q:'Z S IBZ=IBXSAV E("RX-UB-0 4",Z) D SE T2 | |
| 250 | . S Z=0 F S Z=$O(I BXSAVE("PR OS-UB-04", Z)) Q:'Z S IBZ=IBXS AVE("PROS- UB-04",Z) D SET2 | |
| 251 | D END | |
| 252 | Q | |
| 253 | ; | |
| 254 | RV ;rev co des sorted by bedsec tion - no longer use d as of pa tch IB*2*5 1 | |
| 255 | S (IBBSN, IBBS,IBNOC HG)=0 F S IBBS=$O(^ DGCR(399,I BIFN,"RC", "ABS",IBBS )) Q:'IBBS D | |
| 256 | . S IBRV= 0 F S IBR V=$O(^DGCR (399,IBIFN ,"RC","ABS ",IBBS,IBR V)) Q:'IBR V D | |
| 257 | .. S IBDA =0 F S IB DA=$O(^DGC R(399,IBIF N,"RC","AB S",IBBS,IB RV,IBDA)) Q:'IBDA D | |
| 258 | ... S IBX =$G(^DGCR( 399,IBIFN, "RC",IBDA, 0)) | |
| 259 | ... S IBZ =$P($G(^DG CR(399.1,+ $P(IBX,U,5 ),0)),U,1) S IBBSN=I BZ,IBZ=IBX ,IBNOCHG=I BNOCHG+$P( IBZ,U,9) D SET1 | |
| 260 | ; | |
| 261 | ;loop thr ough all r ev codes, print thos e with no bedsection | |
| 262 | S IBDA=0 F S IBDA= $O(^DGCR(3 99,IBIFN," RC",IBDA)) Q:'IBDA S IBZ=$G(^ (IBDA,0)) I +IBZ,$P( IBZ,U,5)=" " S IBNOCH G=IBNOCHG+ $P(IBZ,U,9 ) D SET1 | |
| 263 | ; | |
| 264 | TOTAL ;add total | |
| 265 | ;I +$P(IB CBCOMM,U,2 ) S IBZ="" ,$P(IBZ,U, 2)="SUBTOT AL",$P(IBZ ,U,4)=+$P( IBCBCOMM,U ,1) D SET1 | |
| 266 | ; | |
| 267 | ;S IBX=$S (+$P(IBCBC OMM,U,2):4 ,1:2) D SP ACE | |
| 268 | S IBX=2 D SPACE | |
| 269 | ;S IBZ="" D SET2 | |
| 270 | ;S IBJ=0 F IBI=4,5, 6 S IBJ=IB J+$P(IBCU2 ,U,IBI) | |
| 271 | ;I +$P(IB CBCOMM,U,2 ),+$P(IBCB COMM,U,2)' =IBJ S (IB I,IBZ)="", $P(IBZ,U,2 )="LESS "_ $P(IBCBCOM M,U,3),$P( IBZ,U,4)=+ $P(IBCBCOM M,U,2) D S ET1 S IBZ= "" D SET2 | |
| 272 | ; | |
| 273 | ;S IBZ="0 01",$P(IBZ ,U,2)="TOT AL",$P(IBZ ,U,4)=IBCB COMM-$S(IB I="":$P(IB CBCOMM,U,2 ),1:0) S:I BNOCHG $P( IBZ,U,9)=$ G(IBNOCHG) D SET1 | |
| 274 | ; | |
| 275 | ; | |
| 276 | CPT ;add a dditional procedures | |
| 277 | ;G:$G(IBF L(80))'>6 OPV S IBX= +IBFL(80)- 4 D SPACE | |
| 278 | ;S IBZ="" D SET2 | |
| 279 | ;S IBZ="A DDITIONAL PROCEDURE CODES:" D SET2 | |
| 280 | ;S IBI=6 F S IBI=$ O(IBFL(80, IBI)) Q:'I BI D | |
| 281 | ;. S IBX= $P(IBFL(80 ,IBI),U,2) ,IBZ=$E(IB X,1,2)_"/" _$E(IBX,3, 4)_"/"_$E( IBX,5,6)_$ J(" ",5)_$ P(IBFL(80, IBI),U,1) D SET2 | |
| 282 | ; | |
| 283 | OPV ;add o utpatient visit date s | |
| 284 | ;G:'$O(^D GCR(399,IB IFN,"OP",0 )) CONT S (IBX,IBY)= 0 F S IBX =$O(^DGCR( 399,IBIFN, "OP",IBX)) Q:'IBX S IBY=IBY+1 | |
| 285 | ;S IBX=IB Y/3,IBX=IB X\1+$S(+$P (IBX,".",2 ):1,1:0)+1 D SPACE | |
| 286 | ;S IBZ="" D SET2 S IBZ="OP VI SIT DATE(S ) BILLED:" _$J(" ",34 -24) | |
| 287 | ;S (IBI,I BJ)=0 F S IBI=$O(^D GCR(399,IB IFN,"OP",I BI)) Q:'IB I D | |
| 288 | ;. S Y=$G (^DGCR(399 ,IBIFN,"OP ",IBI,0)), IBZ=IBZ_$$ FMTE^XLFDT (Y,2)_$S($ O(^DGCR(39 9,IBIFN,"O P",IBI)):" , ",1:"") | |
| 289 | ;. S IBJ= IBJ+1 I IB J>2 D SET2 S IBZ=$J( " ",34),IB J=0 | |
| 290 | ;I $L(IBZ )>34 D SET 2 | |
| 291 | ; | |
| 292 | CONT ;D ^I BCF331 ;Mo re free te xt - can n o longer p rint on UB -04 | |
| 293 | ; | |
| 294 | ; fill in rest of p age | |
| 295 | END D:'$G( IBNOCOM) F ILLPG S $P (^TMP($J," IBC-RC"),U ,2)=0 S IB PG=+$G(^TM P($J,"IBC- RC")),IBX= IBPG/22,IB PG=IBX\1+$ S(+$P(IBX, ".",2):1,1 :0) | |
| 296 | K IBZ,IBB SN,IBBS,IB RV,IBDA,IB LN,IBCOL,I BLINES,IBA RRAY,IBNOC HG,IBNOCOM ,IBXSAVE(" RX-UB-04") ,IBXSAVE(" PROS-UB-04 ") | |
| 297 | Q | |
| 298 | ; | |
| 299 | SPACE ;che cks to see if IBX ca n fit on p age, if no t starts n ew page | |
| 300 | Q:'IBX N IBLN,IBY S IBLN=+$G (^TMP($J," IBC-RC")), IBY=IBLN#2 2 S:IBY=0& (IBLN'=0) IBY=22 I I BX>(IBLINE S-IBY) D F ILLPG | |
| 301 | Q | |
| 302 | ; | |
| 303 | FILLPG ;fi ll rest of page with blank lin es | |
| 304 | N IBI,IBL N,IBZ S IB FILL=1 F I BI=1:1:22 S IBLN=+$G (^TMP($J," IBC-RC")) Q:'(IBLN#2 2) S IBZ= "" D FILLU P Q:IBFILL =2 | |
| 305 | K IBFILL Q | |
| 306 | ; | |
| 307 | SET1 ; add rev codes to array: rev cd ^ rev cd st abbrev. ^ CPT CODE ^ unit char ge ^ units ^ total ^ non-cov c harge ^ fo rm locator 49 ^ rev code mult ien ^ cpt modifiers attached t o revenue code/proce dure (unli nked)^ out pt serv da te | |
| 308 | ;formats for output into spec ific colum n blocks 4 2-48 | |
| 309 | ; | |
| 310 | ;JRA;IB*2 .0*??? Add Unit/Basi s of Measu re to arra y - added after 'un its' so th e string a bove will be changed to: | |
| 311 | ;rev cd ^ rev cd st abbrev. ^ CPT CODE ^ unit cha rge ^ unit s (Qty) ^ unit/basis of measur e ^ total ^ non-cov charge ^ f orm locato r 49 ^ rev code mult ien ^ cpt modifiers attached to revenue code/proc edure (unl inked)^ ou tpt serv d ate | |
| 312 | ; | |
| 313 | N IBX,IBY ,IBLN,IBN, IBMOD | |
| 314 | D NEXTLN S IBY="" | |
| 315 | ;set up r ev cd item with appr opriate ou tput value s, non-rev cd entrie s for old bills shou ld already be in ext ernal form | |
| 316 | S IBN=$P( IBZ,U,9) ; non-covere d charges | |
| 317 | S IBMOD=$ P(IBZ,U,10 ) I IBMOD' ="" S IBMO D=$E($TR(I BMOD,",;") ,1,4) ; cp t modifier s | |
| 318 | I +IBZ S IBX=$G(^DG CR(399.2,+ IBZ,0)) Q: IBX="" D | |
| 319 | . S IBY=$ P(IBX,U,1) _U_$P(IBX, U,2)_U_$$P RCD^IBCEF1 ($P(IBZ,U, 6)_";ICPT( ")_IBMOD | |
| 320 | . S IBY=I BY_U_$P(IB Z,U,2)_U_$ P(IBZ,U,3) _U_$P(IBZ, U,4)_U_IBN _U_$P(IBZ, U,13)_U_$G (IBDA)_U_U _$$DATE^IB CF2($P(IBZ ,U,14),"", 1) | |
| 321 | I IBY="" S IBY=$P(I BZ,U,1)_U_ $P(IBZ,U,2 )_U_U_U_$P (IBZ,U,3)_ U_$P(IBZ,U ,4)_U_IBN_ U_$P(IBZ,U ,13)_U_$G( IBDA)_U_U_ $$DATE^IBC F2($P(IBZ, U,14),"",1 ) | |
| 322 | S IBLN=+$ G(^TMP($J, "IBC-RC")) +1,^TMP($J ,"IBC-RC", IBLN)=1_U_ IBY,^TMP($ J,"IBC-RC" )=IBLN I ' (IBLN#22) S IBLINES= 22 | |
| 323 | Q | |
| 324 | ; | |
| 325 | SET2 ;set free text into block 42 array | |
| 326 | Q:$G(IBNO COM) ;No comments w anted | |
| 327 | N IBLN D NEXTLN S I BCOL=$S('I BCOL:2,1:3 ) | |
| 328 | S IBLN=+$ G(^TMP($J, "IBC-RC")) +1 I IBLN# 22=1,$G(IB FILL) S IB FILL=2 Q | |
| 329 | S ^TMP($J ,"IBC-RC", IBLN)=IBCO L_U_IBZ,^T MP($J,"IBC -RC")=IBLN I '(IBLN# 22) S IBLI NES=22 | |
| 330 | Q | |
| 331 | ; | |
| 332 | FILLUP ; F ill block 42 with bl ank lines | |
| 333 | N IBLN D NEXTLN S I BCOL=$S('I BCOL:2,1:3 ) | |
| 334 | S IBLN=+$ G(^TMP($J, "IBC-RC")) +1 I IBLN# 22=1,$G(IB FILL) S IB FILL=2 Q | |
| 335 | S ^TMP($J ,"IBC-RC", IBLN)=IBCO L_U_IBZ,^T MP($J,"IBC -RC")=IBLN I '(IBLN# 22) S IBLI NES=22 | |
| 336 | Q | |
| 337 | ; | |
| 338 | NEXTLN ;ch ecks count er for nex t line, re sets if ne cessary, | |
| 339 | ;ie. if t he line # indicated by the nex t line # v ar. has al ready been used then this incr ements the next line # var. | |
| 340 | S IBLN=+$ G(^TMP($J, "IBC-RC")) +1 I $D(^T MP($J,"IBC -RC",IBLN) ) S ^TMP($ J,"IBC-RC" )=IBLN S:' (IBLN#22) IBLINES=22 G NEXTLN | |
| 341 | Q | |
| 342 | ; | |
| 343 | MOD(RCLN,I BIFN) ; re turn modif ier(s) for a directl y linked C PT charge or for an indirectly linked on e | |
| 344 | N IBCPTN, IBMOD | |
| 345 | S IBMOD=" " | |
| 346 | I $P($G(R CLN),U,10) =4 S IBCPT N=+$P(RCLN ,U,11) I + IBCPTN S I BMOD=$$GET MOD^IBEFUN C(IBIFN,IB CPTN,1) ;L inked | |
| 347 | I IBMOD=" ",$P(RCLN, U,14)'="" S IBMOD=$T R($P(RCLN, U,14),";", ",") ; Not linked or linked, b ut manuall y entered modifiers only | |
| 348 | MODQ Q IBM OD | |
| 349 | ; | |
| 350 | DATE45(IBI FN,IBXDATA ,IBDATE) ; What prin ts in the service da te box of UB-04 | |
| 351 | ; INPUT: | |
| 352 | ; IBIFN = ien of bill | |
| 353 | ; IBDAT E = the de fault outp t service date | |
| 354 | ; OUTPUT: | |
| 355 | ; IBXDA TA = the o utput form atter arra y with the service d ates | |
| 356 | ; (pass by refere nce) | |
| 357 | N Z,Z0,IB R,IBIN | |
| 358 | S IBIN=$$ INPAT^IBCE F(IBXIEN,1 ) | |
| 359 | F Z=1:1 Q :'$D(^TMP( $J,"IBC-RC ",Z)) S I BR=^(Z) D | |
| 360 | . S Z0=$S (+IBR=1&'I BIN&(+$P(I BR,U,2)'=1 ):$S($P(IB R,U,12):$P (IBR,U,12) ,1:$G(IBDA TE)),+IBR= 2:$E($P(IB R,U,2),46, 52),1:$E($ P(IBR,U,2) ,41,47)) | |
| 361 | . S:Z'>22 IBXDATA(Z )=Z0 D:Z>2 2 CKREV^IB CEF3(Z,Z0) | |
| 362 | Q | |
| 363 | ; | |
| 364 | Modified L ogic (Chan ges are hi ghlighted in yellow) | |
| 365 | IBCF33 ;AL B/ARH - UB -04 CMS-14 50 (GATHER CODES) ;2 5-AUG-1993 | |
| 366 | ;;2.0;INT EGRATED BI LLING;**52 ,80,109,51 ,230,349,5 77**;21-MA R-94;Build 46 | |
| 367 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
| 368 | ; | |
| 369 | ;IBIFN re quired | |
| 370 | ; | |
| 371 | ; Not all free text prints in these blo cks as of MRA/EDI - only print | |
| 372 | ; REVEN UE CODES a nd associa ted data, Rx's and p rosthetics | |
| 373 | ; and l ast line t o indicate multiple pages | |
| 374 | N IBI,IBJ ,IBCU2,IBC OL,IBSTATE ,IBCBILL,I BINPAT,IBX ,IBY,Z,IBZ ,IBLPG | |
| 375 | S IBLINES =22,IBCU2= $G(^DGCR(3 99,IBIFN," U2")),IBCO L=1,IBNOCO M=0 | |
| 376 | K IBXSAVE ("RX-UB-04 "),IBXSAVE ("PROS-UB- 04") | |
| 377 | D HOS^IBC EF22(IBIFN ) | |
| 378 | ; | |
| 379 | I $$TXMT^ IBCEF4(IBI FN) S IBNO COM=1 | |
| 380 | S Z="",IB NOCHG=0 | |
| 381 | ; Add tot al line as last entr y, if not already th ere | |
| 382 | ;S IBLCT= $O(IBXDATA (""),-1) | |
| 383 | ;I IBLCT, $P(IBXDATA (IBLCT),U) '="001" S IBXDATA(IB LCT+1)="00 1" | |
| 384 | ;S IBLCT= 0 | |
| 385 | S IBLPG=( $O(IBXDATA (""),-1)+$ O(IBXSAVE( "RX-UB-04" ,""),-1)+$ O(IBXSAVE( "PROS-UB-0 4",""),-1) )/22,IBLPG =IBLPG\1+$ S($P(IBLPG ,".",2):1, 1:0) | |
| 386 | F S Z=$O (IBXDATA(Z )) Q:'Z D | |
| 387 | . N IBZ1 | |
| 388 | . ;I $P(I BXDATA(Z), U)="001",' $O(IBXDATA (Z)) S IBZ ="001",$P( IBZ,U,4)=$ P(IBCBCOMM ,U,1),IBDA =0 S:IBNOC HG $P(IBZ, U,9)=$G(IB NOCHG) S I BXDATA(Z)= IBZ D SET1 Q | |
| 389 | . ;Get mo difiers | |
| 390 | . S IBZ1= $G(^DGCR(3 99,IBIFN," RC",+$P(IB XDATA(Z),U ,8),0)),IB MOD="" | |
| 391 | . I $P(IB Z1,U,6),$S ($P(IBZ1,U ,10)=4:$P( IBZ1,U,11) ,1:'$P(IBZ 1,U,10)) S $P(IBXDAT A(Z),U,9)= $$MOD(IBZ1 ,IBIFN) | |
| 392 | . S IBZ=$ P(IBXDATA( Z),U)_U_$P (IBXDATA(Z ),U,3,5)_" ^^"_$P(IBX DATA(Z),U, 2),$P(IBZ, U,9)=$P(IB XDATA(Z),U ,6),$P(IBZ ,U,13)=$P( IBXDATA(Z) ,U,7),$P(I BZ,U,10)=$ P(IBXDATA( Z),U,9),$P (IBZ,U,14) =$P(IBXDAT A(Z),U,10) | |
| 393 | . ;VD Add "NDC#", "U nit/Basis of Measure ", and "Un its/Qty" t o pieces 2 0,21,22 of IBZ, resp ectively | |
| 394 | . S $P(IB Z,U,20)=$P (IBXDATA(Z ),U,11),$P (IBZ,U,21) =$P(IBXDAT A(Z),U,13) | |
| 395 | . S $P(IB Z,U,22)=$P (IBXDATA(Z ),U,12) | |
| 396 | . I IBZ S IBNOCHG=I BNOCHG+$P( IBXDATA(Z) ,U,6),IBDA =$P(IBXDAT A(Z),U,8) D SET1 | |
| 397 | . ;S IBLC T=IBLCT+1 | |
| 398 | I $D(IBXS AVE("RX-UB -04"))!$D( IBXSAVE("P ROS-UB-04" )) D | |
| 399 | . N Z | |
| 400 | . S Z=0 F S Z=$O(I BXSAVE("RX -UB-04",Z) ) Q:'Z S IBZ=IBXSAV E("RX-UB-0 4",Z) D SE T2 | |
| 401 | . S Z=0 F S Z=$O(I BXSAVE("PR OS-UB-04", Z)) Q:'Z S IBZ=IBXS AVE("PROS- UB-04",Z) D SET2 | |
| 402 | D END | |
| 403 | Q | |
| 404 | ; | |
| 405 | RV ;rev co des sorted by bedsec tion - no longer use d as of pa tch IB*2*5 1 | |
| 406 | S (IBBSN, IBBS,IBNOC HG)=0 F S IBBS=$O(^ DGCR(399,I BIFN,"RC", "ABS",IBBS )) Q:'IBBS D | |
| 407 | . S IBRV= 0 F S IBR V=$O(^DGCR (399,IBIFN ,"RC","ABS ",IBBS,IBR V)) Q:'IBR V D | |
| 408 | .. S IBDA =0 F S IB DA=$O(^DGC R(399,IBIF N,"RC","AB S",IBBS,IB RV,IBDA)) Q:'IBDA D | |
| 409 | ... S IBX =$G(^DGCR( 399,IBIFN, "RC",IBDA, 0)) | |
| 410 | ... S IBZ =$P($G(^DG CR(399.1,+ $P(IBX,U,5 ),0)),U,1) S IBBSN=I BZ,IBZ=IBX ,IBNOCHG=I BNOCHG+$P( IBZ,U,9) D SET1 | |
| 411 | ; | |
| 412 | ;loop thr ough all r ev codes, print thos e with no bedsection | |
| 413 | S IBDA=0 F S IBDA= $O(^DGCR(3 99,IBIFN," RC",IBDA)) Q:'IBDA S IBZ=$G(^ (IBDA,0)) I +IBZ,$P( IBZ,U,5)=" " S IBNOCH G=IBNOCHG+ $P(IBZ,U,9 ) D SET1 | |
| 414 | ; | |
| 415 | TOTAL ;add total | |
| 416 | ;I +$P(IB CBCOMM,U,2 ) S IBZ="" ,$P(IBZ,U, 2)="SUBTOT AL",$P(IBZ ,U,4)=+$P( IBCBCOMM,U ,1) D SET1 | |
| 417 | ; | |
| 418 | ;S IBX=$S (+$P(IBCBC OMM,U,2):4 ,1:2) D SP ACE | |
| 419 | S IBX=2 D SPACE | |
| 420 | ;S IBZ="" D SET2 | |
| 421 | ;S IBJ=0 F IBI=4,5, 6 S IBJ=IB J+$P(IBCU2 ,U,IBI) | |
| 422 | ;I +$P(IB CBCOMM,U,2 ),+$P(IBCB COMM,U,2)' =IBJ S (IB I,IBZ)="", $P(IBZ,U,2 )="LESS "_ $P(IBCBCOM M,U,3),$P( IBZ,U,4)=+ $P(IBCBCOM M,U,2) D S ET1 S IBZ= "" D SET2 | |
| 423 | ; | |
| 424 | ;S IBZ="0 01",$P(IBZ ,U,2)="TOT AL",$P(IBZ ,U,4)=IBCB COMM-$S(IB I="":$P(IB CBCOMM,U,2 ),1:0) S:I BNOCHG $P( IBZ,U,9)=$ G(IBNOCHG) D SET1 | |
| 425 | ; | |
| 426 | ; | |
| 427 | CPT ;add a dditional procedures | |
| 428 | ;G:$G(IBF L(80))'>6 OPV S IBX= +IBFL(80)- 4 D SPACE | |
| 429 | ;S IBZ="" D SET2 | |
| 430 | ;S IBZ="A DDITIONAL PROCEDURE CODES:" D SET2 | |
| 431 | ;S IBI=6 F S IBI=$ O(IBFL(80, IBI)) Q:'I BI D | |
| 432 | ;. S IBX= $P(IBFL(80 ,IBI),U,2) ,IBZ=$E(IB X,1,2)_"/" _$E(IBX,3, 4)_"/"_$E( IBX,5,6)_$ J(" ",5)_$ P(IBFL(80, IBI),U,1) D SET2 | |
| 433 | ; | |
| 434 | OPV ;add o utpatient visit date s | |
| 435 | ;G:'$O(^D GCR(399,IB IFN,"OP",0 )) CONT S (IBX,IBY)= 0 F S IBX =$O(^DGCR( 399,IBIFN, "OP",IBX)) Q:'IBX S IBY=IBY+1 | |
| 436 | ;S IBX=IB Y/3,IBX=IB X\1+$S(+$P (IBX,".",2 ):1,1:0)+1 D SPACE | |
| 437 | ;S IBZ="" D SET2 S IBZ="OP VI SIT DATE(S ) BILLED:" _$J(" ",34 -24) | |
| 438 | ;S (IBI,I BJ)=0 F S IBI=$O(^D GCR(399,IB IFN,"OP",I BI)) Q:'IB I D | |
| 439 | ;. S Y=$G (^DGCR(399 ,IBIFN,"OP ",IBI,0)), IBZ=IBZ_$$ FMTE^XLFDT (Y,2)_$S($ O(^DGCR(39 9,IBIFN,"O P",IBI)):" , ",1:"") | |
| 440 | ;. S IBJ= IBJ+1 I IB J>2 D SET2 S IBZ=$J( " ",34),IB J=0 | |
| 441 | ;I $L(IBZ )>34 D SET 2 | |
| 442 | ; | |
| 443 | CONT ;D ^I BCF331 ;Mo re free te xt - can n o longer p rint on UB -04 | |
| 444 | ; | |
| 445 | ; fill in rest of p age | |
| 446 | END D:'$G( IBNOCOM) F ILLPG S $P (^TMP($J," IBC-RC"),U ,2)=0 S IB PG=+$G(^TM P($J,"IBC- RC")),IBX= IBPG/22,IB PG=IBX\1+$ S(+$P(IBX, ".",2):1,1 :0) | |
| 447 | K IBZ,IBB SN,IBBS,IB RV,IBDA,IB LN,IBCOL,I BLINES,IBA RRAY,IBNOC HG,IBNOCOM ,IBXSAVE(" RX-UB-04") ,IBXSAVE(" PROS-UB-04 ") | |
| 448 | Q | |
| 449 | ; | |
| 450 | SPACE ;che cks to see if IBX ca n fit on p age, if no t starts n ew page | |
| 451 | Q:'IBX N IBLN,IBY S IBLN=+$G (^TMP($J," IBC-RC")), IBY=IBLN#2 2 S:IBY=0& (IBLN'=0) IBY=22 I I BX>(IBLINE S-IBY) D F ILLPG | |
| 452 | Q | |
| 453 | ; | |
| 454 | FILLPG ;fi ll rest of page with blank lin es | |
| 455 | N IBI,IBL N,IBZ S IB FILL=1 F I BI=1:1:22 S IBLN=+$G (^TMP($J," IBC-RC")) Q:'(IBLN#2 2) S IBZ= "" D FILLU P Q:IBFILL =2 | |
| 456 | K IBFILL Q | |
| 457 | ; | |
| 458 | SET1 ; add rev codes to array: rev cd ^ rev cd st abbrev. ^ CPT CODE ^ unit char ge ^ units ^ total ^ non-cov c harge ^ fo rm locator 49 ^ rev code mult ien ^ cpt modifiers attached t o revenue code/proce dure (unli nked)^ out pt serv da te | |
| 459 | ;formats for output into spec ific colum n blocks 4 2-48 | |
| 460 | N IBX,IBY ,IBLN,IBN, IBMOD | |
| 461 | D NEXTLN S IBY="" | |
| 462 | ;set up r ev cd item with appr opriate ou tput value s, non-rev cd entrie s for old bills shou ld already be in ext ernal form | |
| 463 | S IBN=$P( IBZ,U,9) ; non-covere d charges | |
| 464 | S IBMOD=$ P(IBZ,U,10 ) I IBMOD' ="" S IBMO D=$E($TR(I BMOD,",;") ,1,4) ; cp t modifier s | |
| 465 | I +IBZ S IBX=$G(^DG CR(399.2,+ IBZ,0)) Q: IBX="" D | |
| 466 | . S IBY=$ P(IBX,U,1) _U_$P(IBX, U,2)_U_$$P RCD^IBCEF1 ($P(IBZ,U, 6)_";ICPT( ")_IBMOD | |
| 467 | . S IBY=I BY_U_$P(IB Z,U,2)_U_$ P(IBZ,U,3) _U_$P(IBZ, U,4)_U_IBN _U_$P(IBZ, U,13)_U_$G (IBDA)_U_U _$$DATE^IB CF2($P(IBZ ,U,14),"", 1) | |
| 468 | I IBY="" S IBY=$P(I BZ,U,1)_U_ $P(IBZ,U,2 )_U_U_U_$P (IBZ,U,3)_ U_$P(IBZ,U ,4)_U_IBN_ U_$P(IBZ,U ,13)_U_$G( IBDA)_U_U_ $$DATE^IBC F2($P(IBZ, U,14),"",1 ) | |
| 469 | S $P(IBY, U,20,22)=$ P(IBZ,U,20 ,22) ;VD Add "NDC#" , "Unit/Ba sis of Mea sure", and "Units/Qt y" to IBY | |
| 470 | S IBLN=+$ G(^TMP($J, "IBC-RC")) +1,^TMP($J ,"IBC-RC", IBLN)=1_U_ IBY,^TMP($ J,"IBC-RC" )=IBLN I ' (IBLN#22) S IBLINES= 22 | |
| 471 | Q | |
| 472 | ; | |
| 473 | SET2 ;set free text into block 42 array | |
| 474 | Q:$G(IBNO COM) ;No comments w anted | |
| 475 | N IBLN D NEXTLN S I BCOL=$S('I BCOL:2,1:3 ) | |
| 476 | S IBLN=+$ G(^TMP($J, "IBC-RC")) +1 I IBLN# 22=1,$G(IB FILL) S IB FILL=2 Q | |
| 477 | S ^TMP($J ,"IBC-RC", IBLN)=IBCO L_U_IBZ,^T MP($J,"IBC -RC")=IBLN I '(IBLN# 22) S IBLI NES=22 | |
| 478 | Q | |
| 479 | ; | |
| 480 | FILLUP ; F ill block 42 with bl ank lines | |
| 481 | N IBLN D NEXTLN S I BCOL=$S('I BCOL:2,1:3 ) | |
| 482 | S IBLN=+$ G(^TMP($J, "IBC-RC")) +1 I IBLN# 22=1,$G(IB FILL) S IB FILL=2 Q | |
| 483 | S ^TMP($J ,"IBC-RC", IBLN)=IBCO L_U_IBZ,^T MP($J,"IBC -RC")=IBLN I '(IBLN# 22) S IBLI NES=22 | |
| 484 | Q | |
| 485 | ; | |
| 486 | NEXTLN ;ch ecks count er for nex t line, re sets if ne cessary, | |
| 487 | ;ie. if t he line # indicated by the nex t line # v ar. has al ready been used then this incr ements the next line # var. | |
| 488 | S IBLN=+$ G(^TMP($J, "IBC-RC")) +1 I $D(^T MP($J,"IBC -RC",IBLN) ) S ^TMP($ J,"IBC-RC" )=IBLN S:' (IBLN#22) IBLINES=22 G NEXTLN | |
| 489 | Q | |
| 490 | ; | |
| 491 | MOD(RCLN,I BIFN) ; re turn modif ier(s) for a directl y linked C PT charge or for an indirectly linked on e | |
| 492 | N IBCPTN, IBMOD | |
| 493 | S IBMOD=" " | |
| 494 | I $P($G(R CLN),U,10) =4 S IBCPT N=+$P(RCLN ,U,11) I + IBCPTN S I BMOD=$$GET MOD^IBEFUN C(IBIFN,IB CPTN,1) ;L inked | |
| 495 | I IBMOD=" ",$P(RCLN, U,14)'="" S IBMOD=$T R($P(RCLN, U,14),";", ",") ; Not linked or linked, b ut manuall y entered modifiers only | |
| 496 | MODQ Q IBM OD | |
| 497 | ; | |
| 498 | DATE45(IBI FN,IBXDATA ,IBDATE) ; What prin ts in the service da te box of UB-04 | |
| 499 | ; INPUT: | |
| 500 | ; IBIFN = ien of bill | |
| 501 | ; IBDAT E = the de fault outp t service date | |
| 502 | ; OUTPUT: | |
| 503 | ; IBXDA TA = the o utput form atter arra y with the service d ates | |
| 504 | ; (pass by refere nce) | |
| 505 | N Z,Z0,IB R,IBIN | |
| 506 | S IBIN=$$ INPAT^IBCE F(IBXIEN,1 ) | |
| 507 | F Z=1:1 Q :'$D(^TMP( $J,"IBC-RC ",Z)) S I BR=^(Z) D | |
| 508 | . S Z0=$S (+IBR=1&'I BIN&(+$P(I BR,U,2)'=1 ):$S($P(IB R,U,12):$P (IBR,U,12) ,1:$G(IBDA TE)),+IBR= 2:$E($P(IB R,U,2),46, 52),1:$E($ P(IBR,U,2) ,41,47)) | |
| 509 | . S:Z'>22 IBXDATA(Z )=Z0 D:Z>2 2 CKREV^IB CEF3(Z,Z0) | |
| 510 | Q | |
| 511 | ; | |
| 512 | ||
| 513 | The FORMAT CODE of F L-43 (in t he IB FORM FIELD CON TENT file [#364.7], entry 1406 ) needs to be change d FROM: | |
| 514 | ||
| 515 | COLUMN 6 REV COD E DESCRIPT ION (FL-43 ) 364. 6[1706] 36 4.7[1406] 364.5[5] | |
| 516 | Length=2 5 | |
| 517 | Max L ines=0 | |
| 518 | >Consta nt Value: "" | |
| 519 | N Z,Z0,Z1 F Z=1:1 Q: '$D(^TMP($ J,"IBC-RC" ,Z)) S Z1 =^(Z),Z0=$ S(+Z1=1:$E ($P(Z1 | |
| 520 | ,U,3),1,24 ),+Z1=2:$E ($P(Z1,U,2 ),6,30),1: $E($P(Z1,U ,2),1,25)) S:Z'>22 I BXDATA(Z)= | |
| 521 | Z0 D:Z>22 CKREV^IBCE F3(Z,Z0) | |
| 522 | ||
| 523 | Output fro m what Fil e: BILL/CL AIMS// 364 .7 IB FOR M FIELD CO NTENT ( 1664 entri es) | |
| 524 | Select IB FORM FIELD CONTENT F ORM FIELD REFERENCE: `1406 UB -04 N- GET FROM P | |
| 525 | REVIOUS EX TRACT 1 19 6 R EV CODE DE SCRIPTION (FL-43) | |
| 526 | Another on e: | |
| 527 | Standard C aptioned O utput? Yes // (Yes) | |
| 528 | Include CO MPUTED fie lds: (N/Y /R/B): NO/ /- No reco rd number (IEN), no Computed F ields | |
| 529 | ||
| 530 | FORM FIELD REFERENCE : UB-04 SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 531 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
| 532 | PAD CHAR ACTER: NO PAD REQUIR ED | |
| 533 | ||
| 534 | FORMAT COD E: N Z,Z0, Z1 F Z=1:1 Q:'$D(^TM P($J,"IBC- RC",Z)) S Z1=^(Z),Z 0=$S(+Z1 | |
| 535 | =1:$E($P(Z 1,U,3),1,2 4),+Z1=2:$ E($P(Z1,U, 2),6,30),1 :$E($P(Z1, U,2),1,25) ) S:Z'>22 | |
| 536 | IBXDATA(Z) =Z0 D:Z>22 CKREV^IBC EF3(Z,Z0) | |
| 537 | ||
| 538 | FORMAT COD E DESCRIPT ION: Thi s data ele ment is a group data element w here | |
| 539 | more than one occur rence migh t be expec ted. It r elies on t he presenc e of data | |
| 540 | in array IBXSAVE("R EV",n) ext racted pre viously. The first '^' piece of the | |
| 541 | array ind icates whe ther this is a 'norm al' servic e data lin e (=1) or a text | |
| 542 | line (=2 or =3). F or a norma l service line, the data is fo und in the third | |
| 543 | '^' piece of the ar ray. For text line where the first piec e = 2, the text is | |
| 544 | assumed T O start in column 1, so the da ta is extr acted from positions 6-30. | |
| 545 | For text line where the first piece = 3 , the text is assume d to start in | |
| 546 | column 6, so the da ta for thi s field is extracted from posi tions 1-25 . Since | |
| 547 | only 22 l ines of se rvice line can appea r on one f orm, if th ere are mo re than | |
| 548 | 22 lines, subsequen t pages ar e forced f or the rem aining dat a lines af ter 22. | |
| 549 | ||
| 550 | TO: | |
| 551 | N Z,A,B,C F Z=1: Q:' $D(^TMP($J ,"IBC-RC", Z)) S B=^ (Z),C=$$B4 3^IBCEF77( B), | |
| 552 | A=$S(+B=1: $S(C]"":C, 1:$E($P(B, U,3),1,24) ),+B=2:$S( C]"":C,1:$ E($P(B,U,2 ),6,30)), | |
| 553 | 1:$S(C]"": C,1:$E($P( B,U,2),1,2 5))) S:Z'> 22 IBXDATA (Z)=A D:Z> 22 CKREV^I BCEF3(Z,A) | |
| 554 | ||
| 555 | (NOTE: We are changi ng the var iables Z0 and Z1 in the above FORMAT COD E, to A an d B and al so adding variable C . This ne eded to ha ppen due t o the leng th of the MUMPS comm and line. Also neede d to creat e the new module of code “B43^ IBCEF77”) | |
| 556 | ||
| 557 | ||
| 558 | The IBY577 PR Pre-Ins tall routi ne needs t o be coded to includ e the INS- 15, INS-16 and PRF-2 3 Output F ormatter m odificatio ns mention ed above: | |
| 559 | ||
| 560 | Routines | |
| 561 | Activities | |
| 562 | Routine Na me | |
| 563 | IBY577PR | |
| 564 | Enhancemen t Category | |
| 565 | New | |
| 566 | Modify | |
| 567 | Delete | |
| 568 | No Change | |
| 569 | RTM | |
| 570 | ||
| 571 | Related Op tions | |
| 572 | None | |
| 573 | Related Ro utines | |
| 574 | Routines “ Called By” | |
| 575 | Routines “ Called” | |
| 576 | ||
| 577 | ||
| 578 | ||
| 579 | ||
| 580 | Data Dicti onary (DD) Reference s | |
| 581 | IB DATA EL EMENT DEFI NITION Fil e [#364.7] | |
| 582 | Related Pr otocols | |
| 583 | None | |
| 584 | Related In tegration Control Re gistration s (ICRs) | |
| 585 | None | |
| 586 | Data Passi ng | |
| 587 | Input | |
| 588 | Output Re ference | |
| 589 | Both | |
| 590 | Global Re ference | |
| 591 | Local | |
| 592 | Input Attr ibute Name and Defin ition | |
| 593 | Name: | |
| 594 | Definition : | |
| 595 | Output Att ribute Nam e and Defi nition | |
| 596 | Name: | |
| 597 | Definition : | |
| 598 | Current Lo gic | |
| 599 | N/A | |
| 600 | Modified L ogic (Chan ges are in bold) | |
| 601 | IBY577PR ; ALB/VAD - Pre-Instal lation for IB patch 577 ;06-Ap r-2017 ;;2 .0;INTEGRA TED BILLIN G;**577**; 21-MAR-94; Build 52 ; ; delete all output formatter (O.F.) da ta element s included in build D DELOF Q ;INCLUDE(F ILE,Y) ; f unction to determine if O.F. e ntry shoul d be inclu ded in the build ; F ILE=5,6,7 indicating file 364. x ; Y=ien to file NE W OK,LN,TA G,DATA S O K=0 F LN=2 :1 S TAG=" ENT"_FILE_ "+"_LN,DAT A=$P($T(@T AG),";;",2 ) Q:DATA=" " I $F(DA TA,U_Y_U) S OK=1 Q Q OK ; ;Del ete edited entries t o insure c lean insta ll of new entries ;D elete obso lete entri es.DELOF ; Delete included O F entries NEW FILE,D IK,LN,TAG, TAGLN,DATA ,PCE,DA,Y F FILE=5,6 ,7 S DIK=" ^IBA(364." _FILE_"," D . F TAG= "ENT"_FILE ,"DEL"_FIL E D .. F L N=2:1 S TA GLN=TAG_"+ "_LN,DATA= $P($T(@TAG LN),";;",2 ) Q:DATA=" " D ... F PCE=2:1 S DA=$P(DAT A,U,PCE) Q :'DA I $D (^IBA("364 ."_FILE,DA ,0)) D ^DI K Q ; ; Ex ample for ENT5, ENT6 , ENT7, DE L5, DEL6, and DEL7: ;;^195^254 ^259^269^3 24^325^ ; Note: Must have begi nning and ending up- carat ; ;- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ; 364.5 e ntries mod ified: ;EN T5 ; OF en tries in f ile 364.5 to be incl uded ; ;; ; ;------- ---------- ---------- ---------- ---------- ---------- ---------- ---- ; 364 .6 entries modified: ;ENT6 ; O .F. entrie s in file 364.6 to b e included ; ;; ; ;- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ; 364.7 e ntries mod ified: ; | |
| 602 | ; 1406 - INS.15 | |
| 603 | ;ENT7 ; O .F. entrie s in file 364.7 to b e included ; ;;^1406 ^ ; ;----- ---------- ---------- ---------- ---------- ---------- ---------- ------ ; 3 64.5 entri es deleted : ;DEL5 ; remove O.F. entri es in file 364.5 (no t re-added ) ; ;; ; ; ---------- ---------- ---------- ---------- ---------- ---------- ---------- - ; 364.6 entries de leted: ; ; DEL6 ; remove O.F . entries in file 36 4.6 (not r e-added) ; ;; ; ;--- ---------- ---------- ---------- ---------- ---------- ---------- -------- ; 364.7 ent ries delet ed: ; ;DEL 7 ; rem ove O.F. e ntries in file 364.7 (not re-a dded) ; ;; ; ;------ ---------- ---------- ---------- ---------- ---------- ---------- ----- ; | |
| 604 | ||
| 605 | In order t o remove t he NDC and quantity from FL-80 of the UB -04, the f ollowing c hanges nee d to be ma de to rout ine ^IBCEF 77: | |
| 606 | Routines | |
| 607 | Activities | |
| 608 | Routine Na me | |
| 609 | IBCEF77 | |
| 610 | Enhancemen t Category | |
| 611 | New | |
| 612 | Modify | |
| 613 | Delete | |
| 614 | No Change | |
| 615 | RTM | |
| 616 | ||
| 617 | Related Op tions | |
| 618 | None | |
| 619 | Related Ro utines | |
| 620 | Routines “ Called By” | |
| 621 | Routines “ Called” | |
| 622 | ||
| 623 | ||
| 624 | ||
| 625 | ||
| 626 | Data Dicti onary (DD) Reference s | |
| 627 | “NDC Numbe r” field [ #399.0304, 53] | |
| 628 | “Quantity” field [# 399.0304, 54] | |
| 629 | Related Pr otocols | |
| 630 | None | |
| 631 | Related In tegration Control Re gistration s (ICRs) | |
| 632 | None | |
| 633 | Data Passi ng | |
| 634 | Input | |
| 635 | Output Re ference | |
| 636 | Both | |
| 637 | Global Re ference | |
| 638 | Local | |
| 639 | Input Attr ibute Name and Defin ition | |
| 640 | Name: | |
| 641 | Definition : | |
| 642 | Output Att ribute Nam e and Defi nition | |
| 643 | Name: | |
| 644 | Definition : | |
| 645 | Current Lo gic | |
| 646 | IBCEF77 ;W OIFO/SS - FORMATTER/ EXTRACT BI LL FUNCTIO NS ;31-JUL -03 | |
| 647 | ;; 2.0;INTEGR ATED BILLI NG;**232,2 80,155,290 ,291,320,3 48,349,516 **;21-MAR- 94;Build 1 23 | |
| 648 | ;; Per VA Dir ective 640 2, this ro utine shou ld not be modified. | |
| 649 | ; | |
| 650 | ||
| 651 | … | |
| 652 | ||
| 653 | REMARK(IBI FN,IBXDATA ,OFLG) ; p rocedure t o return a rray of UB -04 remark text | |
| 654 | ; for claim IBIFN. Da ta pulled from field # 402 of f ile 399 an d | |
| 655 | ; formatted into an ar ray IBXDAT A(n) where each line is not gr eater | |
| 656 | ; than 24 ch aracters l ong. This will fit into UB-04 FL-80. | |
| 657 | ; | |
| 658 | ; OFLG=1 onl y when cal led in the output fo rmatter. In this ca se, only | |
| 659 | ; 4 lines in IBXDATA w ill be ret urned. | |
| 660 | ; | |
| 661 | NE W TEXT,LEN ,IBZ,J,PCE ,CHS,NEWCH S,IBK,J,TX ,IBCP1 | |
| 662 | K IBXDATA | |
| 663 | ; | |
| 664 | ; MRD;IB*2.0 *516 - Pul l the Bill Remarks f or the cla im. If th is was | |
| 665 | ; called fro m the Outp ut Formatt er, then l ook at lin es of clai m for | |
| 666 | ; NDC's. If any are f ound, they should be added to the end of TEXT. | |
| 667 | ; | |
| 668 | S TEXT=$P($G (^DGCR(399 ,+$G(IBIFN ),"UF2")), U,3) | |
| 669 | I $G(OFLG) D | |
| 670 | . S J=0 | |
| 671 | . F S J=$O( ^DGCR(399, +$G(IBIFN) ,"CP",J)) Q:'J S IB CP1=$G(^(J ,1)) I $P( IBCP1,U,7) '="" D | |
| 672 | . . I TEXT'= "" S TEXT= TEXT_" " | |
| 673 | . . S TEXT=T EXT_"N4"_$ TR($P(IBCP 1,U,7),"-" )_" UN"_$P (IBCP1,U,8 ) | |
| 674 | . . Q | |
| 675 | . Q | |
| 676 | ; | |
| 677 | ; If there's nothing i n TEXT, th en Quit. | |
| 678 | ; | |
| 679 | I TEXT="" Q | |
| 680 | ; | |
| 681 | ; need to br eak up lar ge words f or word wr apping pur poses to g et | |
| 682 | ; as many ch aracters a s possible in the bo x. | |
| 683 | S LEN=17 | |
| 684 | F PCE=1:1 Q: PCE>$L(TEX T," ") S CHS=$P(TEX T," ",PCE) I $L(CHS) >LEN D | |
| 685 | . S NEWCHS=$ E(CHS,1,LE N)_" "_$E( CHS,LEN+1, 999) | |
| 686 | . S $P(TEXT, " ",PCE)=N EWCHS | |
| 687 | . Q | |
| 688 | ; | |
| 689 | ; When calli ng FSTRNG^ IBJU1 whic h calls ^D IWP, FileM an builds the | |
| 690 | ; array with strings o f max leng th=1 less than what you tell i t. | |
| 691 | ; | |
| 692 | S LEN=20 ; lin e 1 is 19 chars | |
| 693 | D FSTRNG^IBJ U1(TEXT,LE N,.IBZ) ; bui ld IBZ arr ay | |
| 694 | S IBK=$$TRIM ^XLFSTR($G (IBZ(1))) ; sav e off the first line | |
| 695 | S TEXT=$P(TE XT,IBK,2,9 9) ; res tore the r est of the text | |
| 696 | S TEXT=$$TRI M^XLFSTR(T EXT) ; tri m spaces | |
| 697 | ; | |
| 698 | S LEN=25 ; the rest is 2 4 chars | |
| 699 | D FSTRNG^IBJ U1(TEXT,LE N,.IBZ) ; bui ld IBZ arr ay | |
| 700 | S IBXDATA(1) =" "_I BK ; lin e 1 | |
| 701 | S J=0 F S J =$O(IBZ(J) ) Q:'J D ; lin es 2-n | |
| 702 | . I J>3,$G(O FLG) Q ; onl y 4 lines for output formatter | |
| 703 | . S TX=$$TRI M^XLFSTR($ G(IBZ(J))) | |
| 704 | . I TX'="" S IBXDATA(J +1)=TX | |
| 705 | . Q | |
| 706 | Q | |
| 707 | ; | |
| 708 | Modified L ogic (Chan ges are hi ghlighted in yellow) | |
| 709 | IBCEF77 ;W OIFO/SS - FORMATTER/ EXTRACT BI LL FUNCTIO NS ;31-JUL -03 | |
| 710 | ;; 2.0;INTEGR ATED BILLI NG;**232,2 80,155,290 ,291,320,3 48,349,516 ,577**;21- MAR-94;Bui ld 123 | |
| 711 | ;; Per VA Dir ective 640 2, this ro utine shou ld not be modified. | |
| 712 | ; | |
| 713 | ||
| 714 | … | |
| 715 | ||
| 716 | REMARK(IBI FN,IBXDATA ,OFLG) ; p rocedure t o return a rray of UB -04 remark text | |
| 717 | ; for claim IBIFN. Da ta pulled from field # 402 of f ile 399 an d | |
| 718 | ; formatted into an ar ray IBXDAT A(n) where each line is not gr eater | |
| 719 | ; than 24 ch aracters l ong. This will fit into UB-04 FL-80. | |
| 720 | ; | |
| 721 | ; OFLG=1 onl y when cal led in the output fo rmatter. In this ca se, only | |
| 722 | ; 4 lines in IBXDATA w ill be ret urned. | |
| 723 | ; | |
| 724 | NE W TEXT,LEN ,IBZ,J,PCE ,CHS,NEWCH S,IBK,J,TX ,IBCP1 | |
| 725 | K IBXDATA | |
| 726 | ; | |
| 727 | ; MRD;IB*2.0 *516 - Pul l the Bill Remarks f or the cla im. If th is was | |
| 728 | ; called fro m the Outp ut Formatt er, then l ook at lin es of clai m for | |
| 729 | ; NDC's. If any are f ound, they should be added to the end of TEXT. | |
| 730 | ; | |
| 731 | S TEXT=$P($G (^DGCR(399 ,+$G(IBIFN ),"UF2")), U,3) | |
| 732 | ; | |
| 733 | ;V D;IB*2.0*5 77; Begin changes | |
| 734 | ; NDC, Quant ity, and U nit of Mea sure now p rinted in FL-43 | |
| 735 | ; instead of here in F L-80 | |
| 736 | ;I $G(OFLG) D | |
| 737 | ;. S J=0 | |
| 738 | ;. F S J=$O (^DGCR(399 ,+$G(IBIFN ),"CP",J)) Q:'J S I BCP1=$G(^( J,1)) I $P (IBCP1,U,7 )'="" D | |
| 739 | ;. . I TEXT' ="" S TEXT =TEXT_" " | |
| 740 | ;. . S TEXT= TEXT_"N4"_ $TR($P(IBC P1,U,7),"- ")_" UN"_$ P(IBCP1,U, 8) | |
| 741 | ;. . Q | |
| 742 | ;. Q | |
| 743 | ; ;VD;IB*2.0 *577;End C hanges | |
| 744 | ; If there's nothing i n TEXT, th en Quit. | |
| 745 | ; | |
| 746 | I TEXT="" Q | |
| 747 | ; | |
| 748 | ; need to br eak up lar ge words f or word wr apping pur poses to g et | |
| 749 | ; as many ch aracters a s possible in the bo x. | |
| 750 | S LEN=17 | |
| 751 | F PCE=1:1 Q: PCE>$L(TEX T," ") S CHS=$P(TEX T," ",PCE) I $L(CHS) >LEN D | |
| 752 | . S NEWCHS=$ E(CHS,1,LE N)_" "_$E( CHS,LEN+1, 999) | |
| 753 | . S $P(TEXT, " ",PCE)=N EWCHS | |
| 754 | . Q | |
| 755 | ; | |
| 756 | ; When calli ng FSTRNG^ IBJU1 whic h calls ^D IWP, FileM an builds the | |
| 757 | ; array with strings o f max leng th=1 less than what you tell i t. | |
| 758 | ; | |
| 759 | S LEN=20 ; lin e 1 is 19 chars | |
| 760 | D FSTRNG^IBJ U1(TEXT,LE N,.IBZ) ; bui ld IBZ arr ay | |
| 761 | S IBK=$$TRIM ^XLFSTR($G (IBZ(1))) ; sav e off the first line | |
| 762 | S TEXT=$P(TE XT,IBK,2,9 9) ; res tore the r est of the text | |
| 763 | S TEXT=$$TRI M^XLFSTR(T EXT) ; tri m spaces | |
| 764 | ; | |
| 765 | S LEN=25 ; the rest is 2 4 chars | |
| 766 | D FSTRNG^IBJ U1(TEXT,LE N,.IBZ) ; bui ld IBZ arr ay | |
| 767 | S IBXDATA(1) =" "_I BK ; lin e 1 | |
| 768 | S J=0 F S J =$O(IBZ(J) ) Q:'J D ; lin es 2-n | |
| 769 | . I J>3,$G(O FLG) Q ; onl y 4 lines for output formatter | |
| 770 | . S TX=$$TRI M^XLFSTR($ G(IBZ(J))) | |
| 771 | . I TX'="" S IBXDATA(J +1)=TX | |
| 772 | . Q | |
| 773 | Q | |
| 774 | ;B 43(NDCDATA ) ; This i s passed a string an d properly formats i f there is NDC drug informatio n. ; The drug informati on is in p ieces 21-2 3 of that string. ; It was part o f the outp ut formatt er entry 3 64.7[1406] used for FL43 but t hat | |
| 775 | ; It returns a string with N4 - the NDC Dr ug qualifi er ; NDC Code without t he hyphens ; a space ; Uni ts qualifi er | |
| 776 | ; Units ; Ex "N 4123456789 01 ML1.5" I N DCDATA="" Q "" S NDCDAT A=$P(NDCDA TA,U,21,23 ) Q :$P(NDCDAT A,U)="" "" Q "N4"_$TR($ P(NDCDATA, U),"-")_" "_$TR($P(N DCDATA,U,2 ,3),U) | |
| 777 | ; |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.