- 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/IBCEF73A.m
r613 r623 1 IBCEF73A ;ALB/KJH - FORMATTER AND EXTRACTOR SPECIFIC (NPI) BILL FUNCTIONS ;30 Aug 2006 10:38 AM 2 ;;2.0;INTEGRATED BILLING;**343,374,395,391**;21-MAR-94;Build 39 3 ;; Per VHA Directive 10-93-142, this routine should not be modified. 4 ; 5 PROVNPI(IBIEN399,IBNONPI) ; 6 ;Retrieves NPIs from #200 or 355.93 7 ; Input: 8 ; IBIEN399 - IEN of record in BILL/CLAIMS file 399 9 ; IBNONPI - variable to pass info on missing NPI to calling routine. Pass by reference 10 ; Output: 11 ; NPI codes for all providers 12 ; IBNONPI - U-delimited list of provider types with missing NPIs 13 N IBRETVAL,IBPTR,IBFT 14 S IBRETVAL="",IBNONPI="" 15 F IBFT=1:1:9 D 16 . S IBPTR=$$PROVPTR^IBCEF7(IBIEN399,IBFT) 17 . I IBPTR S $P(IBRETVAL,"^",IBFT)=$$GETNPI(IBPTR) 18 Q IBRETVAL 19 GETNPI(IBPTR) ;look for NPI in #200 or #355.93 20 ;Input: IBPTR from 399.0222, field .02 21 ;Output: NPI 22 ;if in file #200 23 N NPI 24 S NPI="" 25 ;if in 200 then get it from 200 26 I $P(IBPTR,";",2)="VA(200," S NPI=$P($$NPI^XUSNPI("Individual_ID",$P(IBPTR,";")),U) S:NPI<1 NPI="" 27 ;if in 355.93 then use 355.93 28 I $P(IBPTR,";",2)="IBA(355.93," S NPI=$$NPIGET^IBCEP81($P(IBPTR,";")) 29 I NPI="",$D(IBNONPI) S IBNONPI=$S(IBNONPI="":IBFT,1:IBNONPI_U_IBFT) 30 Q NPI 31 ; 32 SPECTAX(IBIEN399,IBNOSPEC) ; 33 ;Retrieves Specialty Codes from Current Taxonomy entries for a claim from #399 34 ; Input: 35 ; IBIEN399 - IEN of record in BILL/CLAIMS file 399 36 ; IBNOSPEC - variable to pass info on missing taxonomies to calling routine. Pass by reference 37 ; Output: 38 ; Taxonomy Specialty Codes for all providers 39 ; IBNOSPEC - U-delimited list of provider types with missing Taxonomy Specialty codes 40 N IBRETVAL,IBN,IBFT,IBSPEC,SPEC 41 S IBRETVAL="",IBNOSPEC="" 42 I $G(IBIEN399)="" Q "" 43 F IBFT=1:1:9 D 44 . S IBN=$O(^DGCR(399,IBIEN399,"PRV","B",IBFT,0)) 45 . I +IBN=0 Q 46 . S IBSPEC=$P($G(^DGCR(399,IBIEN399,"PRV",+IBN,0)),"^",15) 47 . S SPEC=$$GET1^DIQ(8932.1,IBSPEC,"SPECIALTY CODE") 48 . S $P(IBRETVAL,"^",IBFT)=SPEC 49 . I SPEC="",$D(IBNOSPEC) S IBNOSPEC=$S(IBNOSPEC="":IBFT,1:IBNOSPEC_U_IBFT) 50 Q IBRETVAL 51 ; 52 PROVTAX(IBIEN399,IBNOTAX) ; 53 ;Retrieves Current Taxonomy entries for a claim from #399 54 ; Input: 55 ; IBIEN399 - IEN of record in BILL/CLAIMS file 399 56 ; IBNOTAX - variable to pass info on missing taxonomies to calling routine. Pass by reference 57 ; Output: 58 ; Taxonomy X12 codes for all providers 59 ; IBNOTAX - U-delimited list of provider types with missing Taxonomy X12 codes 60 N IBRETVAL,IBN,IBFT,IBTAX,TAX 61 S IBRETVAL="",IBNOTAX="" 62 I $G(IBIEN399)="" Q "" 63 F IBFT=1:1:9 D 64 . S IBN=$O(^DGCR(399,IBIEN399,"PRV","B",IBFT,0)) 65 . I +IBN=0 Q 66 . S IBTAX=$P($G(^DGCR(399,IBIEN399,"PRV",+IBN,0)),"^",15) 67 . S TAX=$$GET1^DIQ(8932.1,IBTAX,"X12 CODE") 68 . S $P(IBRETVAL,"^",IBFT)=TAX 69 . I TAX="",$D(IBNOTAX) S IBNOTAX=$S(IBNOTAX="":IBFT,1:IBNOTAX_U_IBFT) 70 Q IBRETVAL 71 GETTAX(IBPTR) ;look for Taxonomy in #200 or #355.93 72 ;Input: IBPTR from 399.0222, field .02 73 ;Output: Taxonomy X12 code_"^"_IEN 74 N TAX 75 S TAX="^" 76 ;if in 200 then get it from 200 77 I $P(IBPTR,";",2)="VA(200," S TAX=$$TAXIND^XUSTAX($P(IBPTR,";")) 78 ;if in 355.93 then use 355.93 79 I $P(IBPTR,";",2)="IBA(355.93," S TAX=$$TAXGET^IBCEP81($P(IBPTR,";")) 80 Q TAX 81 ; 82 ORGNPI(IBIEN399,IBNONPI) ; Extract NPIs for organizations on this claim 83 ; Input 84 ; IBIEN399 - Claim IEN in file 399 85 ; IBNONPI - Variable to pass info on missing NPI back to calling routine. Pass by reference. 86 ; Output - NPI codes for facilities 87 ; Piece 1) Division (Responsible Institution) NPI code 88 ; Piece 2) Non-VA Service Facility NPI code 89 ; Piece 3) Billing Provider NPI code (main VA division) 90 N IBRETVAL,IBORG,IBEVDT,IBDIV,NPI 91 S IBNONPI="" 92 I $G(IBIEN399)="" Q "" 93 S IBRETVAL="" 94 S IBEVDT=$$GET1^DIQ(399,IBIEN399_",",.03,"I") 95 I IBEVDT="" S IBEVDT=DT 96 S IBDIV=$$GET1^DIQ(399,IBIEN399_",",.22,"I") 97 I IBDIV="" S IBDIV=$$PRIM^VASITE(IBEVDT) 98 S IBORG=$P($$SITE^VASITE(IBEVDT,IBDIV),U),NPI="" 99 I IBORG S NPI=$P($$NPI^XUSNPI("Organization_ID",IBORG),U) S:NPI>0 $P(IBRETVAL,U)=NPI 100 I NPI<1,$D(IBNONPI) S IBNONPI=1 101 S IBORG=$$GET1^DIQ(399,IBIEN399_",",232,"I") 102 I IBORG S NPI=$$NPIGET^IBCEP81(IBORG),$P(IBRETVAL,U,2)=NPI I 'NPI,$D(IBNONPI) S IBNONPI=$S(IBNONPI="":2,1:IBNONPI_U_2) 103 S IBORG=$P($$SITE^VASITE,U),NPI="" 104 I IBORG S NPI=$P($$NPI^XUSNPI("Organization_ID",IBORG),U) S:NPI>0 $P(IBRETVAL,U,3)=NPI 105 I NPI<1,$D(IBNONPI) S IBNONPI=$S(IBNONPI="":3,1:IBNONPI_U_3) 106 I $$ISRX^IBCEF1(IBIEN399) S IBORG=$$RXSITE(IBIEN399) I IBORG S NPI=$P($$NPI^XUSNPI("Organization_ID",IBORG),U) S:NPI>0 $P(IBRETVAL,U,3)=NPI 107 Q IBRETVAL 108 ; 109 ORGTAX(IBIEN399,IBNOTAX) ; Extract Taxonomies for organizations on this claim 110 ; Input 111 ; IBIEN399 - Claim IEN in file 399 112 ; IBNOTAX - Variable to pass info on missing taxonomies back to calling routine. Pass by reference. 113 ; Output - Taxonomy X12 codes for facilities 114 ; Piece 1) Division (Responsible Institution) Taxonomy X12 code 115 ; Piece 2) Non-VA Service Facility Taxonomy X12 code 116 ; Piece 3) Billing Provider Taxonomy X12 code (main VA division) 117 N IBRETVAL,IBTAX,TAX 118 S IBTAX=$$GET1^DIQ(399,IBIEN399_",",243,"I") 119 S TAX=$$GET1^DIQ(8932.1,IBTAX,"X12 CODE") 120 S $P(IBRETVAL,U)=TAX 121 I '$L(TAX),$D(IBNOTAX) S IBNOTAX=1 122 S IBTAX=$$GET1^DIQ(399,IBIEN399_",",244,"I") 123 S TAX=$$GET1^DIQ(8932.1,IBTAX,"X12 CODE") 124 S $P(IBRETVAL,U,2)=TAX 125 I '$L(TAX),$$GET1^DIQ(399,IBIEN399_",",232,"I"),$D(IBNOTAX) S IBNOTAX=$S(IBNOTAX="":2,1:IBNOTAX_U_2) 126 S IBORG=$P($$SITE^VASITE,U) 127 S TAX=$P($$TAXORG^XUSTAX(IBORG),U) 128 S $P(IBRETVAL,U,3)=TAX 129 I '$L(TAX),$D(IBNOTAX) S IBNOTAX=$S(IBNOTAX="":3,1:IBNOTAX_U_3) 130 Q IBRETVAL 131 ; 132 RXSITE(IBIEN399,IBLIST) ; returns prescription organization (file 4) pointer 133 ; for the given bill. If IBLIST passed by reference, then a list of 134 ; the possible organizations are returned for a bill, since a bill may 135 ; have more than one prescription. If more than one rx on the bill, the 136 ; $$ return is the pointer of the last prescription found. 137 ; IBLIST(rx ien,fill date)=ORGINATION (file 4 pointer) 138 ; 139 N IBX,IBDATA,IBORG,IBRX,IBDT,IBY,IBRXN,DFN 140 K ^TMP($J,"IBCEF73A") 141 S IBORG=0,DFN=$P($G(^DGCR(399,IBIEN399,0)),"^",2),IBLIST="IBCEF73A" 142 S IBRXN=0 F S IBRXN=$O(^IBA(362.4,"AIFN"_IBIEN399,IBRXN)) Q:'IBRXN S IBX=0 F S IBX=$O(^IBA(362.4,"AIFN"_IBIEN399,IBRXN,IBX)) Q:'IBX D 143 . S IBDATA=$G(^IBA(362.4,IBX,0)) 144 . S IBRX=$P(IBDATA,"^",5),IBDT=$P(IBDATA,"^",3) Q:'IBRX!('IBDT) 145 . D RX^PSO52API(DFN,IBLIST,IBRX,,"0,2,R") 146 . I IBDT=+$G(^TMP($J,"IBCEF73A",DFN,IBRX,22)) S (IBORG,IBLIST(IBRX,IBDT))=$$PSONPI(+$G(^TMP($J,"IBCEF73A",DFN,IBRX,20))) Q 147 . S IBY=0 F S IBY=$O(^TMP($J,"IBCEF73A",DFN,IBRX,"RF",IBY)) Q:'IBY I IBDT=+$G(^TMP($J,"IBCEF73A",DFN,IBRX,"RF",IBY,.01)) S (IBORG,IBLIST(IBRX,IBDT))=$$PSONPI(+$G(^TMP($J,"IBCEF73A",DFN,IBRX,"RF",IBY,8))) Q 148 K ^TMP($J,"IBCEF73A") 149 Q IBORG 150 ; 151 PSONPI(IB59IEN) ; returns institution ien for a file 59 ien 152 N IB4IEN 153 K ^TMP($J,"IBCEF59") 154 D PSS^PSO59(IB59IEN,,"IBCEF59") 155 S IB4IEN=+$G(^TMP($J,"IBCEF59",IB59IEN,101)) 156 K ^TMP($J,"IBCEF59") 157 Q IB4IEN 1 IBCEF73A ;ALB/KJH - FORMATTER AND EXTRACTOR SPECIFIC (NPI) BILL FUNCTIONS ; 30 Aug 2006 10:38 AM 2 ;;2.0;INTEGRATED BILLING;**343,374**;21-MAR-94;Build 16 3 ;; Per VHA Directive 10-93-142, this routine should not be modified. 4 ; 5 PROVNPI(IBIEN399,IBNONPI) ; 6 ;Retrieves NPIs from #200 or 355.93 7 ; Input: 8 ; IBIEN399 - IEN of record in BILL/CLAIMS file 399 9 ; IBNONPI - variable to pass info on missing NPI to calling routine. Pass by reference 10 ; Output: 11 ; NPI codes for all providers 12 ; IBNONPI - U-delimited list of provider types with missing NPIs 13 N IBRETVAL,IBPTR,IBFT 14 S IBRETVAL="",IBNONPI="" 15 F IBFT=1:1:9 D 16 . S IBPTR=$$PROVPTR^IBCEF7(IBIEN399,IBFT) 17 . I IBPTR S $P(IBRETVAL,"^",IBFT)=$$GETNPI(IBPTR) 18 Q IBRETVAL 19 GETNPI(IBPTR) ;look for NPI in #200 or #355.93 20 ;Input: IBPTR from 399.0222, field .02 21 ;Output: NPI 22 ;if in file #200 23 N NPI 24 S NPI="" 25 ;if in 200 then get it from 200 26 I $P(IBPTR,";",2)="VA(200," S NPI=$P($$NPI^XUSNPI("Individual_ID",$P(IBPTR,";")),U) S:NPI=-1 NPI="" 27 ;if in 355.93 then use 355.93 28 I $P(IBPTR,";",2)="IBA(355.93," S NPI=$$NPIGET^IBCEP81($P(IBPTR,";")) 29 I NPI="",$D(IBNONPI) S IBNONPI=$S(IBNONPI="":IBFT,1:IBNONPI_U_IBFT) 30 Q NPI 31 ; 32 SPECTAX(IBIEN399,IBNOSPEC) ; 33 ;Retrieves Specialty Codes from Current Taxonomy entries for a claim from #399 34 ; Input: 35 ; IBIEN399 - IEN of record in BILL/CLAIMS file 399 36 ; IBNOSPEC - variable to pass info on missing taxonomies to calling routine. Pass by reference 37 ; Output: 38 ; Taxonomy Specialty Codes for all providers 39 ; IBNOSPEC - U-delimited list of provider types with missing Taxonomy Specialty codes 40 N IBRETVAL,IBN,IBFT,IBSPEC,SPEC 41 S IBRETVAL="",IBNOSPEC="" 42 I $G(IBIEN399)="" Q "" 43 F IBFT=1:1:9 D 44 . S IBN=$O(^DGCR(399,IBIEN399,"PRV","B",IBFT,0)) 45 . I +IBN=0 Q 46 . S IBSPEC=$P($G(^DGCR(399,IBIEN399,"PRV",+IBN,0)),"^",15) 47 . S SPEC=$$GET1^DIQ(8932.1,IBSPEC,"SPECIALTY CODE") 48 . S $P(IBRETVAL,"^",IBFT)=SPEC 49 . I SPEC="",$D(IBNOSPEC) S IBNOSPEC=$S(IBNOSPEC="":IBFT,1:IBNOSPEC_U_IBFT) 50 Q IBRETVAL 51 ; 52 PROVTAX(IBIEN399,IBNOTAX) ; 53 ;Retrieves Current Taxonomy entries for a claim from #399 54 ; Input: 55 ; IBIEN399 - IEN of record in BILL/CLAIMS file 399 56 ; IBNOTAX - variable to pass info on missing taxonomies to calling routine. Pass by reference 57 ; Output: 58 ; Taxonomy X12 codes for all providers 59 ; IBNOTAX - U-delimited list of provider types with missing Taxonomy X12 codes 60 N IBRETVAL,IBN,IBFT,IBTAX,TAX 61 S IBRETVAL="",IBNOTAX="" 62 I $G(IBIEN399)="" Q "" 63 F IBFT=1:1:9 D 64 . S IBN=$O(^DGCR(399,IBIEN399,"PRV","B",IBFT,0)) 65 . I +IBN=0 Q 66 . S IBTAX=$P($G(^DGCR(399,IBIEN399,"PRV",+IBN,0)),"^",15) 67 . S TAX=$$GET1^DIQ(8932.1,IBTAX,"X12 CODE") 68 . S $P(IBRETVAL,"^",IBFT)=TAX 69 . I TAX="",$D(IBNOTAX) S IBNOTAX=$S(IBNOTAX="":IBFT,1:IBNOTAX_U_IBFT) 70 Q IBRETVAL 71 GETTAX(IBPTR) ;look for Taxonomy in #200 or #355.93 72 ;Input: IBPTR from 399.0222, field .02 73 ;Output: Taxonomy X12 code_"^"_IEN 74 N TAX 75 S TAX="^" 76 ;if in 200 then get it from 200 77 I $P(IBPTR,";",2)="VA(200," S TAX=$$TAXIND^XUSTAX($P(IBPTR,";")) 78 ;if in 355.93 then use 355.93 79 I $P(IBPTR,";",2)="IBA(355.93," S TAX=$$TAXGET^IBCEP81($P(IBPTR,";")) 80 Q TAX 81 ; 82 ORGNPI(IBIEN399,IBNONPI) ; Extract NPIs for organizations on this claim 83 ; Input 84 ; IBIEN399 - Claim IEN in file 399 85 ; IBNONPI - Variable to pass info on missing NPI back to calling routine. Pass by reference. 86 ; Output - NPI codes for facilities 87 ; Piece 1) Division (Responsible Institution) NPI code 88 ; Piece 2) Non-VA Service Facility NPI code 89 ; Piece 3) Billing Provider NPI code (main VA division) 90 N IBRETVAL,IBORG,IBEVDT,IBDIV,NPI 91 S IBNONPI="" 92 I $G(IBIEN399)="" Q "" 93 S IBRETVAL="" 94 S IBEVDT=$$GET1^DIQ(399,IBIEN399_",",.03,"I") 95 I IBEVDT="" S IBEVDT=DT 96 S IBDIV=$$GET1^DIQ(399,IBIEN399_",",.22,"I") 97 I IBDIV="" S IBDIV=$$PRIM^VASITE(IBEVDT) 98 S IBORG=$P($$SITE^VASITE(IBEVDT,IBDIV),U),NPI="" 99 I IBORG S NPI=$P($$NPI^XUSNPI("Organization_ID",IBORG),U) S:NPI'=-1 $P(IBRETVAL,U)=NPI 100 I NPI<1,$D(IBNONPI) S IBNONPI=1 101 S IBORG=$$GET1^DIQ(399,IBIEN399_",",232,"I") 102 I IBORG S NPI=$$NPIGET^IBCEP81(IBORG),$P(IBRETVAL,U,2)=NPI I 'NPI,$D(IBNONPI) S IBNONPI=$S(IBNONPI="":2,1:IBNONPI_U_2) 103 S IBORG=$P($$SITE^VASITE,U),NPI="" 104 I IBORG S NPI=$P($$NPI^XUSNPI("Organization_ID",IBORG),U) S:NPI'=-1 $P(IBRETVAL,U,3)=NPI 105 I NPI<1,$D(IBNONPI) S IBNONPI=$S(IBNONPI="":3,1:IBNONPI_U_3) 106 Q IBRETVAL 107 ; 108 ORGTAX(IBIEN399,IBNOTAX) ; Extract Taxonomies for organizations on this claim 109 ; Input 110 ; IBIEN399 - Claim IEN in file 399 111 ; IBNOTAX - Variable to pass info on missing taxonomies back to calling routine. Pass by reference. 112 ; Output - Taxonomy X12 codes for facilities 113 ; Piece 1) Division (Responsible Institution) Taxonomy X12 code 114 ; Piece 2) Non-VA Service Facility Taxonomy X12 code 115 ; Piece 3) Billing Provider Taxonomy X12 code (main VA division) 116 N IBRETVAL,IBTAX,TAX 117 S IBTAX=$$GET1^DIQ(399,IBIEN399_",",243,"I") 118 S TAX=$$GET1^DIQ(8932.1,IBTAX,"X12 CODE") 119 S $P(IBRETVAL,U)=TAX 120 I '$L(TAX),$D(IBNOTAX) S IBNOTAX=1 121 S IBTAX=$$GET1^DIQ(399,IBIEN399_",",244,"I") 122 S TAX=$$GET1^DIQ(8932.1,IBTAX,"X12 CODE") 123 S $P(IBRETVAL,U,2)=TAX 124 I '$L(TAX),$$GET1^DIQ(399,IBIEN399_",",232,"I"),$D(IBNOTAX) S IBNOTAX=$S(IBNOTAX="":2,1:IBNOTAX_U_2) 125 S IBORG=$P($$SITE^VASITE,U) 126 S TAX=$P($$TAXORG^XUSTAX(IBORG),U) 127 S $P(IBRETVAL,U,3)=TAX 128 I '$L(TAX),$D(IBNOTAX) S IBNOTAX=$S(IBNOTAX="":3,1:IBNOTAX_U_3) 129 Q IBRETVAL
Note:
See TracChangeset
for help on using the changeset viewer.
