- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEF11.m
r613 r623 1 IBCEF11 ;ALB/TMP - FORMATTER SPECIFIC BILL FUNCTIONS - CONT ;30-JAN-96 2 ;;2.0;INTEGRATED BILLING;**51,137,155,309,335,348,349,371**;21-MAR-94;Build 57 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 BOX24D(A,IB) ; Returns the lines for boxes 19-24 of the CMS-1500 display 6 ; IB = flag is 1 if only box 24 is needed 7 Q $S('$G(IB):"36",1:"44")_"^55" 8 ; 9 RCBOX() ; Returns the lines for revenue code boxes of the UB-04 display 10 Q "19^41" 11 ; 12 OUTPT(IBIFN,IBPRINT) ; Returns an array of service line data from 13 ; CMS-1500 box 24. Output is in IBXDATA(n) 14 ; IBPRINT = print flag 1: return print fields 15 ; 0: return EDI fields 16 ; Uses diagnosis array ^TMP("IBXSAVE",$J,"DX",IBIFN,DIAG CODE)=SEQ # 17 ; if it already exists. If not, it builds it from N-DIAGNOSES element 18 ; 19 ; For EDI call: Returns IBXDATA(n)= 20 ; begin date(YYYYMMDD)^end date(YYYYMMDD)^pos^tos^ 21 ; proc code/revenue code - if no procedure (not the pointers)^ 22 ; type of code^dx pointer(s)^unit charge^units^modifiers separated by; 23 ; ^purchased charge amount ^anesthesia minutes^emergency indicator^ 24 ; lab-type service flag. 25 ; 26 ; Also Returns IBXDATA(IBI,"COB",COB,m) with COB data for each line 27 ; item found in an accepted EOB for the bill and = the reference 28 ; line in the first '^' piece followed by the '0' node data of file 29 ; 361.115 (LINE LEVEL ADJUSTMENTS) 30 ; COB = COB sequence # of adjustment's ins co, m = seq # 31 ; -- AND -- 32 ; IBXDATA(IBI,"COB",COB,m,z,p)= 33 ; the data on the '0' node for each subordinate entry of file 34 ; 361.11511 (REASONS) (Only first 3 pieces for 837 output) 35 ; z = group code, sometimes preceeded by a space p = seq # 36 ; 37 ; For Print call: Returns begin date(DDMMYYYY)^end date(DDMMYYYY) or 38 ; null if equal to begin date^pos^tos^bedsection name(if no procedure) 39 ; or procedure code(not the pointer)^ ... refer to EDI call results 40 ; Also, IBXDATA(n,"TEXT")=the text to print on first line of box 24, 41 ; If no procedure code, returns IBXDATA(n,"A")=rev code abbrev 42 ; 43 ; For both calls, returns IBXDATA(n,item type,item ptr)="" 44 ; -- AND -- 45 ; IBXDATA(n,"RX")=RX#^drug name^NDC^refill #^(re)fill date^qty^days 46 ; ^chrge^ien of file 362.4^NDC format 47 ; If line references a prescription 48 ; -- AND -- 49 ; If no revenue code for a prescription, returns IBXDATA(n,"ARX")="" 50 ; -- AND -- 51 ; IBXDATA(n,"AUX")='AUX' node of the procedure entry 52 ; 53 N IB,IBI,IBJ,IBFLD,IBDXI,IBXIEN,Z,IBXTRA,IBRX,IBRX0,IBRX1,Z0,Z1 54 ; 55 K ^TMP($J,"IBITEM") 56 S ^TMP($J,"IBITEM")="" 57 ; Build diagnosis array if not already built 58 I $O(^TMP("IBXSAVE",$J,"DX",IBIFN,""))="",$O(^IBA(362.3,"AIFN"_IBIFN,"")) D 59 .N Z,IBXDATA D F^IBCEF("N-DIAGNOSES",,,IBIFN) 60 .S Z="" F S Z=$O(IBXDATA(Z)) K:$O(IBXDATA(0))=""&(Z="") IBXDATA Q:Z="" S:$P(IBXDATA(Z),U,2) ^TMP("IBXSAVE",$J,"DX",IBIFN,$P(IBXDATA(Z),U,2))=Z 61 ; 62 S IB(0)=$G(^DGCR(399,IBIFN,0)),IB("U")=$G(^("U")),IB("U1")=$G(^("U1")) 63 S IBI="" F S IBI=$O(^TMP("IBXSAVE",$J,"DX",IBIFN,IBI)) Q:IBI="" S IBDXI(IBI)=^(IBI) 64 I '$G(IBPRINT) D RVCE^IBCF23(IBIFN,IBIFN) 65 I $G(IBPRINT) D RVCE^IBCF23(,IBIFN) 66 ; Returns IBFLD(24) = begin date^end date^pos^tos^ 67 ; proc/bedsection/revenue code^dx pointer^unit charge^ 68 ; units^modifiers^ purchased charge amount ^anesthesia minutes^ 69 ; emergency indicator ^ AND 70 ; IBFLD(24,n,type,item)="" 71 ; IBFLD(24,n_"A") = revenue code abbreviation if no procedure 72 ; IBFLD(24,n,"AUX") = 'AUX' node of line item 73 ; IBFLD(24,n,"RX") = soft pointer to file 362.4 from 'item' fld 74 ; (can be null) 75 ; 76 D SET^IBCSC5A(IBIFN,.IBRX) ;prescriptions 77 ; IBRX1(ien 362.4)=RX#^drug ien^NDC^refil #^(re)fil date^qty^days^chrge 78 I IBRX S IBRX="" F S IBRX=$O(IBRX(IBRX)) Q:IBRX="" S IBRX0=0 F S IBRX0=$O(IBRX(IBRX,IBRX0)) Q:'IBRX0 D 79 . N IBRXH 80 . S IBRXH=IBRX(IBRX,IBRX0) 81 . S IBRX1(+IBRXH)=IBRX_U_$P(IBRXH,U,2)_U_$P(IBRXH,U,5)_U_$P(IBRXH,U,7)_U_IBRX0_U_$P(IBRXH,U,4)_U_$P(IBRXH,U,3)_U_$P(IBRXH,U,6)_U_+IBRXH_U_$P(IBRXH,U,8) 82 K IBRX 83 ; 84 ; for EDI, remove any $0 line items from the IBFLD array before 85 ; dropping down into the next loop (IB*2*371) 86 I '$G(IBPRINT) D 87 . NEW IBZ,IBI,Z 88 . M IBZ=IBFLD K IBFLD 89 . S (IBI,Z)=0 90 . F S IBI=$O(IBZ(24,IBI)) Q:IBI'=+IBI D 91 .. I $P(IBZ(24,IBI),U,7)*$P(IBZ(24,IBI),U,8)'>0 Q 92 .. S Z=Z+1 93 .. M IBFLD(24,Z)=IBZ(24,IBI) 94 .. S IBFLD(24)=Z 95 .. Q 96 . Q 97 ; 98 S IBI=0 99 F S IBI=$O(IBFLD(24,IBI)) Q:IBI'=+IBI D 100 . S IBRX1=0 101 . S IBXDATA(IBI)=$P(IBFLD(24,IBI),U)_U_$P(IBFLD(24,IBI),U,$S($P(IBFLD(24,IBI),U,2)=""&'$G(IBPRINT):1,1:2)) 102 . S $P(IBXDATA(IBI),U,3,5)=$P(IBFLD(24,IBI),U,3,5) 103 . S $P(IBXDATA(IBI),U,6)=$S($D(IBFLD(24,IBI_"X")):"CJ",1:"HC") 104 . S $P(IBXDATA(IBI),U,7,13)=$P(IBFLD(24,IBI),U,6,12) 105 . S $P(IBXDATA(IBI),U,14)=+$$ISLAB(IBXDATA(IBI)) 106 . ; 107 . I $D(IBFLD(24,IBI,"RX")) D ;Rx 108 .. S IBRX1=1 109 .. I $P($G(IBFLD(24,IBI,"AUX")),U,8)'="" S $P(IBFLD(24,IBI,"AUX"),U,8)="",$P(IBFLD(24,IBI,"AUX"),U,9)="" ;No free text allowed for rx's 110 .. I $D(IBRX1(+IBFLD(24,IBI,"RX"))) D Q ;Soft link exists 111 ...D ZERO^IBRXUTL(+$P(IBRX1(+IBFLD(24,IBI,"RX")),U,2)) 112 ... S IBXDATA(IBI,"RX")=IBRX1(+IBFLD(24,IBI,"RX")),$P(IBXDATA(IBI,"RX"),U,2)=$E($G(^TMP($J,"IBDRUG",+$P(IBRX1(+IBFLD(24,IBI,"RX")),U,2),.01)),1,30) 113 ... K IBRX1(+IBFLD(24,IBI,"RX")) 114 ... ; No soft link - must find the first Rx with the same charge 115 .. S IBRX="" F S IBRX=$O(IBRX1(IBRX)) Q:'IBRX I +$P(IBRX1(IBRX),U,8)=+$P(IBXDATA(IBI),U,8) D Q 116 ... D ZERO^IBRXUTL(+$P(IBRX1(IBRX),U,2)) 117 ... S IBXDATA(IBI,"RX")=IBRX1(IBRX),$P(IBXDATA(IBI,"RX"),U,2)=$E($G(^TMP($J,"IBDRUG",+$P(IBRX1(IBRX),U,2),.01)),1,30) K IBRX1(IBRX) Q 118 ... Q 119 .. Q 120 . ; 121 . I $G(IBFLD(24,IBI,"AUX"))'="" D 122 .. I $G(IBPRINT),$P(IBFLD(24,IBI,"AUX"),U,8)'="" S IBXDATA(IBI,"TEXT")=$P(IBFLD(24,IBI,"AUX"),U,8),$P(IBFLD(24,IBI,"AUX"),U,8)="" 123 .. S IBXDATA(IBI,"AUX")=IBFLD(24,IBI,"AUX") 124 .. Q 125 . ; 126 . I $G(IBPRINT) D 127 .. I '$P(IBXDATA(IBI),U,8),'$G(IBXDATA(IBI,"RX")) D Q 128 ... I $G(IBNOSHOW) Q ; don't show errors/warnings 129 ... S IBXDATA(IBI,"TEXT")="Warning:** REV CODE UNITS < #PROCEDURES, THEY MUST BE =" 130 ... I $D(IBXDATA(IBI,"AUX")) S $P(IBXDATA(IBI,"AUX"),U,9)="" 131 ... Q 132 .. ; 133 .. I $G(IBFLD(24,IBI_"A"))'="" D Q 134 ... S IBXDATA(IBI,"A")=IBFLD(24,IBI_"A") 135 ... I $G(IBNOSHOW) Q ; don't show errors/warnings 136 ... S IBXDATA(IBI,"TEXT")="Warning:** REV CODE UNITS > #PROCEDURES, THEY MUST BE=: "_IBFLD(24,IBI_"A") 137 ... I $D(IBXDATA(IBI,"AUX")) S $P(IBXDATA(IBI,"AUX"),U,9)="" 138 ... Q 139 .. ; 140 .. S IBRX=$G(IBXDATA(IBI,"RX")) 141 .. I IBRX'="" D ;Format Rx detail 142 ... N Z 143 ... S Z=$P(IBRX,U) 144 ... S Z=$S(Z'="":"Rx#"_Z_" ",1:"RX: ") 145 ... S IBXDATA(IBI,"TEXT")=Z_$S($P(IBRX,U,3)'="":"NDC: "_$P(IBRX,U,3),1:"NOC: "_$P(IBRX,U,2))_" Qty: "_$P(IBRX,U,6)_" Days: "_$P(IBRX,U,7) 146 ... S $P(IBXDATA(IBI,"AUX"),U,9)="N4" ; service line comment qualifier for RX's 147 ... Q 148 .. Q 149 . ; 150 . I '$G(IBPRINT) D COBLINE^IBCEU6(IBIFN,IBI,.IBXDATA,,.IBXTRA) 151 . Q 152 ; 153 I $G(IBPRINT) D 154 . S IBRX=0 F S IBRX=$O(IBRX1(IBRX)) Q:'IBRX D 155 .. S IBI=+$O(IBXDATA(""),-1)+1 156 .. S IBXDATA(IBI)=$$DATE($P(IBRX1(IBRX),U,5)) 157 .. S IBXDATA(IBI,"TEXT")="**** ERROR - NO PROC LINK TO REV CODE FOR DRUG: RX#: "_$P(IBRX1(IBRX),U)_" NDC #: "_$P(IBRX1(IBRX),U,3) 158 .. I $D(IBXDATA(IBI,"AUX")) S $P(IBXDATA(IBI,"AUX"),U,9)="" 159 .. S IBXDATA(IBI,"ARX")="" 160 .. D ZERO^IBRXUTL(+$P(IBRX1(IBRX),U,2)) 161 .. S IBXDATA(IBI,"RX")=IBRX1(IBRX),$P(IBXDATA(IBI,"RX"),U,2)=$E($G(^TMP($J,"IBDRUG",+$P(IBRX1(IBRX),U,2),.01)),1,30) K IBRX1(IBRX) 162 .. Q 163 . Q 164 ; 165 I '$G(IBPRINT),$D(IBXTRA) D COMBO^IBCEU2(.IBXDATA,.IBXTRA,0) ;Handle bundled/unbundled lines 166 K ^TMP($J,"IBDRUG") 167 Q 168 ; 169 ISLAB(LDATA) ; Returns 0/1 if line item data indicates the item is a lab (1) 170 ; 'LAB' is defined here as type of service = 5 171 Q $E($P(LDATA,U,4))="5" 172 ; 173 FMT(DATA,DLEN,FLEN) ; Returns a string in DATA with a max length of DLEN 174 ; and a field length of FLEN 175 Q $E($E(DATA,1,DLEN)_$J("",FLEN),1,FLEN) 176 ; 177 DATE(X,DEL) ; Returns FM date in X as MMxDDxYYYY where x=DEL 178 S DEL=$G(DEL) 179 S X=$$DATE^IBCF2(X,1,1) 180 I X'="" S X=$E(X,1,2)_DEL_$E(X,3,4)_DEL_$E(X,5,8) 181 Q X 182 ; 183 BATCH() ; Sets up record for and stores/returns the next batch number 184 N NUM,FAC,DO,DD,DLAYGO,DIC,X,Y 185 ;Keep latest batch number for view/print edi bill extract data option 186 I $D(IBVNUM) S NUM=IBVNUM G BATCHQ 187 ;Check for batch resubmit - if yes, use same number as original batch 188 I $P($G(^TMP("IBRESUBMIT",$J)),U,3)=1 S NUM=$P(^($J),U) G BATCHQ 189 L +^IBA(364.1,0):5 I '$T Q 0 190 S FAC=+$P($$SITE^VASITE(),U,3),NUM=$O(^IBA(364.1,"B",""),-1) 191 I $D(^IBA(364.1,+NUM,0)),$P(^(0),U,2)="" F D Q:'NUM!($P($G(^IBA(364.1,+NUM,0)),U,2)'="") 192 . I $D(^IBA(364.1,NUM,0)) S DA=NUM,DIK="^IBA(364.1," D ^DIK 193 . S NUM=$O(^IBA(364.1,"B",""),-1) 194 F S NUM=$S($P(NUM,FAC,2)'="":NUM+1,1:FAC_"0000001") Q:'$D(^IBA(364.1,"B",NUM)) 195 K DO,DD S DIC="^IBA(364.1,",DLAYGO=364.1,DIC(0)="L",X=NUM D FILE^DICN K DD,DO I Y'>0 S NUM=0 196 L -^IBA(364.1,0) 197 BATCHQ Q NUM 198 ; 1 IBCEF11 ;ALB/TMP - FORMATTER SPECIFIC BILL FUNCTIONS - CONT ;30-JAN-96 2 ;;2.0;INTEGRATED BILLING;**51,137,155,309,335,348,349**;21-MAR-94;Build 46 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 BOX24D(A,IB) ; Returns the lines for boxes 19-24 of the CMS-1500 display 6 ; IB = flag is 1 if only box 24 is needed 7 Q $S('$G(IB):"36",1:"44")_"^55" 8 ; 9 RCBOX() ; Returns the lines for revenue code boxes of the UB-04 display 10 Q "19^41" 11 ; 12 OUTPT(IBIFN,IBPRINT) ; Returns an array of service line data from 13 ; CMS-1500 box 24. Output is in IBXDATA(n) 14 ; IBPRINT = print flag 1: return print fields 15 ; 0: return EDI fields 16 ; Uses diagnosis array ^TMP("IBXSAVE",$J,"DX",IBIFN,DIAG CODE)=SEQ # 17 ; if it already exists. If not, it builds it from N-DIAGNOSES element 18 ; 19 ; For EDI call: Returns IBXDATA(n)= 20 ; begin date(YYYYMMDD)^end date(YYYYMMDD)^pos^tos^ 21 ; proc code/revenue code - if no procedure (not the pointers)^ 22 ; type of code^dx pointer(s)^unit charge^units^modifiers separated by; 23 ; ^purchased charge amount ^anesthesia minutes^emergency indicator^ 24 ; lab-type service flag. 25 ; 26 ; Also Returns IBXDATA(IBI,"COB",COB,m) with COB data for each line 27 ; item found in an accepted EOB for the bill and = the reference 28 ; line in the first '^' piece followed by the '0' node data of file 29 ; 361.115 (LINE LEVEL ADJUSTMENTS) 30 ; COB = COB sequence # of adjustment's ins co, m = seq # 31 ; -- AND -- 32 ; IBXDATA(IBI,"COB",COB,m,z,p)= 33 ; the data on the '0' node for each subordinate entry of file 34 ; 361.11511 (REASONS) (Only first 3 pieces for 837 output) 35 ; z = group code, sometimes preceeded by a space p = seq # 36 ; 37 ; For Print call: Returns begin date(DDMMYYYY)^end date(DDMMYYYY) or 38 ; null if equal to begin date^pos^tos^bedsection name(if no procedure) 39 ; or procedure code(not the pointer)^ ... refer to EDI call results 40 ; Also, IBXDATA(n,"TEXT")=the text to print on first line of box 24, 41 ; If no procedure code, returns IBXDATA(n,"A")=rev code abbrev 42 ; 43 ; For both calls, returns IBXDATA(n,item type,item ptr)="" 44 ; -- AND -- 45 ; IBXDATA(n,"RX")=RX#^drug name^NDC^refill #^(re)fill date^qty^days 46 ; ^chrge^ien of file 362.4^NDC format 47 ; If line references a prescription 48 ; -- AND -- 49 ; If no revenue code for a prescription, returns IBXDATA(n,"ARX")="" 50 ; -- AND -- 51 ; IBXDATA(n,"AUX")='AUX' node of the procedure entry 52 ; 53 N IB,IBI,IBJ,IBFLD,IBDXI,IBXIEN,Z,IBXTRA,IBRX,IBRX0,IBRX1,Z0,Z1 54 ; 55 K ^TMP($J,"IBITEM") 56 S ^TMP($J,"IBITEM")="" 57 ; Build diagnosis array if not already built 58 I $O(^TMP("IBXSAVE",$J,"DX",IBIFN,""))="",$O(^IBA(362.3,"AIFN"_IBIFN,"")) D 59 .N Z,IBXDATA D F^IBCEF("N-DIAGNOSES",,,IBIFN) 60 .S Z="" F S Z=$O(IBXDATA(Z)) K:$O(IBXDATA(0))=""&(Z="") IBXDATA Q:Z="" S:$P(IBXDATA(Z),U,2) ^TMP("IBXSAVE",$J,"DX",IBIFN,$P(IBXDATA(Z),U,2))=Z 61 ; 62 S IB(0)=$G(^DGCR(399,IBIFN,0)),IB("U")=$G(^("U")),IB("U1")=$G(^("U1")) 63 S IBI="" F S IBI=$O(^TMP("IBXSAVE",$J,"DX",IBIFN,IBI)) Q:IBI="" S IBDXI(IBI)=^(IBI) 64 I '$G(IBPRINT) D RVCE^IBCF23(IBIFN,IBIFN) 65 I $G(IBPRINT) D RVCE^IBCF23(,IBIFN) 66 ; Returns IBFLD(24) = begin date^end date^pos^tos^ 67 ; proc/bedsection/revenue code^dx pointer^unit charge^ 68 ; units^modifiers^ purchased charge amount ^anesthesia minutes^ 69 ; emergency indicator ^ AND 70 ; IBFLD(24,n,type,item)="" 71 ; IBFLD(24,n_"A") = revenue code abbreviation if no procedure 72 ; IBFLD(24,n,"AUX") = 'AUX' node of line item 73 ; IBFLD(24,n,"RX") = soft pointer to file 362.4 from 'item' fld 74 ; (can be null) 75 ; 76 D SET^IBCSC5A(IBIFN,.IBRX) ;prescriptions 77 ; IBRX1(ien 362.4)=RX#^drug ien^NDC^refil #^(re)fil date^qty^days^chrge 78 I IBRX S IBRX="" F S IBRX=$O(IBRX(IBRX)) Q:IBRX="" S IBRX0=0 F S IBRX0=$O(IBRX(IBRX,IBRX0)) Q:'IBRX0 D 79 . N IBRXH 80 . S IBRXH=IBRX(IBRX,IBRX0) 81 . S IBRX1(+IBRXH)=IBRX_U_$P(IBRXH,U,2)_U_$P(IBRXH,U,5)_U_$P(IBRXH,U,7)_U_IBRX0_U_$P(IBRXH,U,4)_U_$P(IBRXH,U,3)_U_$P(IBRXH,U,6)_U_+IBRXH_U_$P(IBRXH,U,8) 82 K IBRX 83 ; 84 S IBI=0 85 F S IBI=$O(IBFLD(24,IBI)) Q:IBI'=+IBI D 86 . S IBRX1=0 87 . I '$G(IBPRINT) Q:$P(IBFLD(24,IBI),U,7)*$P(IBFLD(24,IBI),U,8)'>0 ; For EDI, ignore 0-charge line items 88 . S IBXDATA(IBI)=$P(IBFLD(24,IBI),U)_U_$P(IBFLD(24,IBI),U,$S($P(IBFLD(24,IBI),U,2)=""&'$G(IBPRINT):1,1:2)) 89 . S $P(IBXDATA(IBI),U,3,5)=$P(IBFLD(24,IBI),U,3,5) 90 . S $P(IBXDATA(IBI),U,6)=$S($D(IBFLD(24,IBI_"X")):"CJ",1:"HC") 91 . S $P(IBXDATA(IBI),U,7,13)=$P(IBFLD(24,IBI),U,6,12) 92 . S $P(IBXDATA(IBI),U,14)=+$$ISLAB(IBXDATA(IBI)) 93 . ; 94 . I $D(IBFLD(24,IBI,"RX")) D ;Rx 95 .. S IBRX1=1 96 .. I $P($G(IBFLD(24,IBI,"AUX")),U,8)'="" S $P(IBFLD(24,IBI,"AUX"),U,8)="",$P(IBFLD(24,IBI,"AUX"),U,9)="" ;No free text allowed for rx's 97 .. I $D(IBRX1(+IBFLD(24,IBI,"RX"))) D Q ;Soft link exists 98 ...D ZERO^IBRXUTL(+$P(IBRX1(+IBFLD(24,IBI,"RX")),U,2)) 99 ... S IBXDATA(IBI,"RX")=IBRX1(+IBFLD(24,IBI,"RX")),$P(IBXDATA(IBI,"RX"),U,2)=$E($G(^TMP($J,"IBDRUG",+$P(IBRX1(+IBFLD(24,IBI,"RX")),U,2),.01)),1,30) 100 ... K IBRX1(+IBFLD(24,IBI,"RX")) 101 ... ; No soft link - must find the first Rx with the same charge 102 .. S IBRX="" F S IBRX=$O(IBRX1(IBRX)) Q:'IBRX I +$P(IBRX1(IBRX),U,8)=+$P(IBXDATA(IBI),U,8) D Q 103 ... D ZERO^IBRXUTL(+$P(IBRX1(IBRX),U,2)) 104 ... S IBXDATA(IBI,"RX")=IBRX1(IBRX),$P(IBXDATA(IBI,"RX"),U,2)=$E($G(^TMP($J,"IBDRUG",+$P(IBRX1(IBRX),U,2),.01)),1,30) K IBRX1(IBRX) Q 105 ... Q 106 .. Q 107 . ; 108 . I $G(IBFLD(24,IBI,"AUX"))'="" D 109 .. I $G(IBPRINT),$P(IBFLD(24,IBI,"AUX"),U,8)'="" S IBXDATA(IBI,"TEXT")=$P(IBFLD(24,IBI,"AUX"),U,8),$P(IBFLD(24,IBI,"AUX"),U,8)="" 110 .. S IBXDATA(IBI,"AUX")=IBFLD(24,IBI,"AUX") 111 .. Q 112 . ; 113 . I $G(IBPRINT) D 114 .. I '$P(IBXDATA(IBI),U,8),'$G(IBXDATA(IBI,"RX")) D Q 115 ... I $G(IBNOSHOW) Q ; don't show errors/warnings 116 ... S IBXDATA(IBI,"TEXT")="Warning:** REV CODE UNITS < #PROCEDURES, THEY MUST BE =" 117 ... I $D(IBXDATA(IBI,"AUX")) S $P(IBXDATA(IBI,"AUX"),U,9)="" 118 ... Q 119 .. ; 120 .. I $G(IBFLD(24,IBI_"A"))'="" D Q 121 ... S IBXDATA(IBI,"A")=IBFLD(24,IBI_"A") 122 ... I $G(IBNOSHOW) Q ; don't show errors/warnings 123 ... S IBXDATA(IBI,"TEXT")="Warning:** REV CODE UNITS > #PROCEDURES, THEY MUST BE=: "_IBFLD(24,IBI_"A") 124 ... I $D(IBXDATA(IBI,"AUX")) S $P(IBXDATA(IBI,"AUX"),U,9)="" 125 ... Q 126 .. ; 127 .. S IBRX=$G(IBXDATA(IBI,"RX")) 128 .. I IBRX'="" D ;Format Rx detail 129 ... N Z 130 ... S Z=$P(IBRX,U) 131 ... S Z=$S(Z'="":"Rx#"_Z_" ",1:"RX: ") 132 ... S IBXDATA(IBI,"TEXT")=Z_$S($P(IBRX,U,3)'="":"NDC: "_$P(IBRX,U,3),1:"NOC: "_$P(IBRX,U,2))_" Qty: "_$P(IBRX,U,6)_" Days: "_$P(IBRX,U,7) 133 ... S $P(IBXDATA(IBI,"AUX"),U,9)="N4" ; service line comment qualifier for RX's 134 ... Q 135 .. Q 136 . ; 137 . I '$G(IBPRINT) D COBLINE^IBCEU6(IBIFN,IBI,.IBXDATA,,.IBXTRA) 138 . Q 139 ; 140 I $G(IBPRINT) D 141 . S IBRX=0 F S IBRX=$O(IBRX1(IBRX)) Q:'IBRX D 142 .. S IBI=+$O(IBXDATA(""),-1)+1 143 .. S IBXDATA(IBI)=$$DATE($P(IBRX1(IBRX),U,5)) 144 .. S IBXDATA(IBI,"TEXT")="**** ERROR - NO PROC LINK TO REV CODE FOR DRUG: RX#: "_$P(IBRX1(IBRX),U)_" NDC #: "_$P(IBRX1(IBRX),U,3) 145 .. I $D(IBXDATA(IBI,"AUX")) S $P(IBXDATA(IBI,"AUX"),U,9)="" 146 .. S IBXDATA(IBI,"ARX")="" 147 .. D ZERO^IBRXUTL(+$P(IBRX1(IBRX),U,2)) 148 .. S IBXDATA(IBI,"RX")=IBRX1(IBRX),$P(IBXDATA(IBI,"RX"),U,2)=$E($G(^TMP($J,"IBDRUG",+$P(IBRX1(IBRX),U,2),.01)),1,30) K IBRX1(IBRX) 149 .. Q 150 . Q 151 ; 152 I '$G(IBPRINT),$D(IBXTRA) D COMBO^IBCEU2(.IBXDATA,.IBXTRA,0) ;Handle bundled/unbundled lines 153 K ^TMP($J,"IBDRUG") 154 Q 155 ; 156 ISLAB(LDATA) ; Returns 0/1 if line item data indicates the item is a lab (1) 157 ; 'LAB' is defined here as type of service = 5 158 Q $E($P(LDATA,U,4))="5" 159 ; 160 FMT(DATA,DLEN,FLEN) ; Returns a string in DATA with a max length of DLEN 161 ; and a field length of FLEN 162 Q $E($E(DATA,1,DLEN)_$J("",FLEN),1,FLEN) 163 ; 164 DATE(X,DEL) ; Returns FM date in X as MMxDDxYYYY where x=DEL 165 S DEL=$G(DEL) 166 S X=$$DATE^IBCF2(X,1,1) 167 I X'="" S X=$E(X,1,2)_DEL_$E(X,3,4)_DEL_$E(X,5,8) 168 Q X 169 ; 170 BATCH() ; Sets up record for and stores/returns the next batch number 171 N NUM,FAC,DO,DD,DLAYGO,DIC,X,Y 172 ;Keep latest batch number for view/print edi bill extract data option 173 I $D(IBVNUM) S NUM=IBVNUM G BATCHQ 174 ;Check for batch resubmit - if yes, use same number as original batch 175 I $P($G(^TMP("IBRESUBMIT",$J)),U,3)=1 S NUM=$P(^($J),U) G BATCHQ 176 L +^IBA(364.1,0):5 I '$T Q 0 177 S FAC=+$P($$SITE^VASITE(),U,3),NUM=$O(^IBA(364.1,"B",""),-1) 178 I $D(^IBA(364.1,+NUM,0)),$P(^(0),U,2)="" F D Q:'NUM!($P($G(^IBA(364.1,+NUM,0)),U,2)'="") 179 . I $D(^IBA(364.1,NUM,0)) S DA=NUM,DIK="^IBA(364.1," D ^DIK 180 . S NUM=$O(^IBA(364.1,"B",""),-1) 181 F S NUM=$S($P(NUM,FAC,2)'="":NUM+1,1:FAC_"0000001") Q:'$D(^IBA(364.1,"B",NUM)) 182 K DO,DD S DIC="^IBA(364.1,",DLAYGO=364.1,DIC(0)="L",X=NUM D FILE^DICN K DD,DO I Y'>0 S NUM=0 183 L -^IBA(364.1,0) 184 BATCHQ Q NUM 185 ;
Note:
See TracChangeset
for help on using the changeset viewer.
