Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBACSV

IBACSV.m

Go to the documentation of this file.
  1. IBACSV ;WOIFO/AAT - CODE SET VERSIONING IB UTILITIES ;19-FEB-03
  1. ;;2.0;INTEGRATED BILLING;**210,266,461**;21-MAR-94;Build 58
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. Q
  1. ;
  1. ;*** DD calls ***
  1. ; Called from Data Dictionary of 399, subfile 399.30416, field .02
  1. B30416 ;
  1. S ICPTVDT=$$BDATE($G(DA(2)),$G(DA(1))) ; Date of service
  1. S DIC("S")="I $$MODP^ICPTMOD(+$G(^DGCR(399,DA(2),""CP"",DA(1),0)),+Y,""I"",ICPTVDT)>0"
  1. S DIC("W")="D EN^DDIOL("" ""_$P($$MOD^ICPTMOD(+Y,""I"",ICPTVDT),U,3),,""?0"")"
  1. Q
  1. ;
  1. ;*** API calls ***
  1. ;
  1. ;Returns data of the CPT code, NULL if error
  1. ;Input: IBC-code, IBDT-date (default is today)
  1. ;Output: (by reference) - IBERROR - error string if error happened
  1. ;DO NOT USE THIS CALL TO DETERMINE ACTIVE/INACTIVE STATUS OF THE CODE
  1. CPT(IBC,IBDT,IBERROR) N IBINF
  1. I '$G(IBDT) S IBDT=DT
  1. S IBERROR=""
  1. S IBINF=$$CPT^ICPTCOD(IBC,IBDT,1) ;Local codes supported
  1. I IBINF<0 S IBERROR=$P(IBINF,U,2),IBINF=""
  1. Q $P(IBINF,U,2,999) ;Remove the first piece (IEN)
  1. ;
  1. ;Returns data of the ICD Operational code, NULL if error
  1. ;Input: IBC-code, IBDT-date (default is today)
  1. ;Output: (by reference) - IBERROR - error string if error happened
  1. ;DO NOT USE THIS CALL TO DETERMINE ACTIVE/INACTIVE STATUS OF THE CODE
  1. ICD0(IBC,IBDT,IBERROR) N IBINF
  1. I '$G(IBDT) S IBDT=DT
  1. S IBERROR=""
  1. S IBINF=$$ICDOP^ICDEX(IBC,IBDT,,"I",1) ;Local codes supported
  1. I IBINF<0 S IBERROR=$P(IBINF,U,2),IBINF=""
  1. Q $P(IBINF,U,2,999) ;Remove the first piece (IEN)
  1. ;
  1. ;Returns data of the ICD Diagnosis code, NULL if error
  1. ;Input: IBC-code, IBDT-date (default is today)
  1. ;Output: (by reference) - IBERROR - error string if error happened
  1. ;DO NOT USE THIS CALL TO DETERMINE ACTIVE/INACTIVE STATUS OF THE CODE
  1. ICD9(IBC,IBDT,IBERROR) N IBINF
  1. I '$G(IBDT) S IBDT=DT
  1. S IBERROR=""
  1. S IBINF=$$ICDDX^ICDEX(IBC,IBDT,,"I",1) ; Local codes supported
  1. I IBINF<0 S IBERROR=$P(IBINF,U,2),IBINF=""
  1. Q $P(IBINF,U,2,999) ;Remove the first piece (IEN)
  1. ;
  1. ;Returns data of the DRG code, NULL if error
  1. ;Input: IBC-code, IBDT-date (default is today)
  1. ;Output: (by reference) - IBERROR - error string if error happened
  1. DRG(IBC,IBDT,IBERROR) N IBINF
  1. I '$G(IBDT) S IBDT=DT
  1. S IBERROR=""
  1. S IBINF=$$DRG^ICDGTDRG(IBC,IBDT)
  1. I IBINF<0 S IBERROR=$P(IBINF,U,2),IBINF=""
  1. Q IBINF ;Format of the DRG API is different - the first piece doesn't need to be removed.
  1. ;
  1. ;
  1. ; ==== Determine Active Status for CPT,ICD0,ICD9 and DRG codes ====
  1. ;Used by DD for screening CPT codes
  1. ;Is the given code active for the date? (default-today)
  1. CPTACT(IEN,IBDT) N IBINF,IBRES
  1. I '$G(IBDT) S IBDT=DT
  1. S IBRES=0
  1. S IBINF=$$CPT^ICPTCOD(IEN,IBDT)
  1. I IBINF'<0,$P(IBINF,U,7) S IBRES=1
  1. Q IBRES
  1. ;
  1. ;Is the given code active for the date? (default-today)
  1. ICD0ACT(IEN,IBDT) N IBINF,IBRES
  1. I '$G(IBDT) S IBDT=DT
  1. S IBRES=0
  1. S IBINF=$$LS^ICDEX(80.1,IEN,IBDT)
  1. I IBINF>0 S IBRES=1
  1. Q IBRES
  1. ;
  1. ;Is the given code active for the date? (default-today)
  1. ICD9ACT(IEN,IBDT) N IBINF,IBRES
  1. I '$G(IBDT) S IBDT=DT
  1. S IBRES=0
  1. S IBINF=$$LS^ICDEX(80,IEN,IBDT)
  1. I IBINF>0 S IBRES=1
  1. Q IBRES
  1. ;
  1. ;Is the given code active for the date? (default-today)
  1. DRGACT(IEN,IBDT) N IBINF,IBRES
  1. I '$G(IBDT) S IBDT=DT
  1. S IBRES=0
  1. S IBINF=$$DRG^ICDGTDRG(IEN,IBDT)
  1. I IBINF'<0,$P(IBINF,U,14) S IBRES=1
  1. Q IBRES
  1. ;
  1. ;
  1. ; ==== Determine Record Number (IEN) for CPT, ICD0, ICD9 and DRG codes ====
  1. ; Note: the Date of Service doesn't matter here!
  1. ;Input: IBC-name
  1. ;Returns: IEN of the code (or NULL if not valid)
  1. CPTIEN(IBC) N IBINF,IBRES
  1. S IBRES=""
  1. S IBINF=$$CPT^ICPTCOD(IBC)
  1. I IBINF>0 S IBRES=$P(IBINF,U)
  1. Q IBRES
  1. ;
  1. ;Input: IBC-name
  1. ;Returns: IEN of the code (or NULL if not valid)
  1. ICD0IEN(IBC) N IBINF,IBRES
  1. S IBRES=""
  1. S IBINF=$$ICDOP^ICDEX(IBC,,,"E")
  1. I IBINF>0 S IBRES=$P(IBINF,U)
  1. Q IBRES
  1. ;
  1. ;Input: IBC-name
  1. ;Returns: IEN of the code (or NULL if not valid)
  1. ICD9IEN(IBC) N IBINF,IBRES
  1. S IBRES=""
  1. S IBINF=$$ICDDX^ICDEX(IBC,,,"E")
  1. I IBINF>0 S IBRES=$P(IBINF,U)
  1. Q IBRES
  1. ;
  1. ;Input: IBC-name
  1. ;Returns: IEN of the code (or NULL if not valid)
  1. DRGIEN(IBC) N IBINF,IBRES
  1. S IBRES=""
  1. S IBINF=$$DRG^ICDGTDRG(IBC)
  1. I IBINF'<0 S IBRES=$P(IBINF,U,17)
  1. Q IBRES
  1. ;
  1. ;
  1. ; ==== Determine Coding Version ICD0, ICD9 codes ====
  1. ;Returns the ICD Procedure code version (ICD9=2, ICD10=31)
  1. ICD0VER(IEN) N IBINF,IBRES
  1. S IBRES=""
  1. S IBINF=$$ICDOP^ICDEX(IEN,,,"I")
  1. I IBINF>0 S IBRES=$P(IBINF,U,15)
  1. Q IBRES
  1. ;
  1. ;Returns the ICD Diagnosis code version (ICD9=1, ICD10=30)
  1. ICD9VER(IEN) N IBINF,IBRES
  1. S IBRES=""
  1. S IBINF=$$ICDDX^ICDEX(IEN,,,"I")
  1. I IBINF>0 S IBRES=$P(IBINF,U,20)
  1. Q IBRES
  1. ;
  1. ;
  1. ; ==== Determine Coding System ICD-9, ICD-10 ====
  1. ;Returns ICD Procedure system on date (ICD9=2, ICD10=31)
  1. ICD0SYS(IBDT) N IBINF,IBRES
  1. S IBRES=""
  1. I '$G(IBDT) S IBDT=DT
  1. S IBINF=$$SYS^ICDEX(80.1,IBDT)
  1. I IBINF>0 S IBRES=+IBINF
  1. Q IBRES
  1. ;
  1. ;Returns ICD Diagnosis system on date (ICD9=1, ICD10=30)
  1. ICD9SYS(IBDT) N IBINF,IBRES
  1. S IBRES=""
  1. I '$G(IBDT) S IBDT=DT
  1. S IBINF=$$SYS^ICDEX(80,IBDT)
  1. I IBINF>0 S IBRES=+IBINF
  1. Q IBRES
  1. ;
  1. ;
  1. ; ==== Bill's Date of Service (for diagnosis codes, revenue codes) ====
  1. ; The STATEMENT TO DATE of the bill is used as a date of service for CSV
  1. BDATE(IBIFN,PROC) ;
  1. ; PROC (Optional) - IEN of PROCEDURES sub-file.
  1. ; if PROC is defined, the function will try to return the date of procedure first.
  1. N IBDAT
  1. S IBDAT=""
  1. I '$G(IBIFN) Q ""
  1. ; The following line of code is for entering new procedures.
  1. ; If PROC is defined, but NULL - that means adding new procedure to 399.
  1. ; Therefore we try to use DGPROCDT variable prior to the bill's Service Date
  1. ; This is limited to CPTs, ICD Procedures use the bills service date (ICD-10)
  1. I $D(PROC),$P($G(^DGCR(399,+IBIFN,0)),U,9)=9 K PROC
  1. I $D(PROC),'PROC,$G(DGPROCDT)>0 S IBDAT=DGPROCDT
  1. I $G(PROC) S IBDAT=$P($P($G(^DGCR(399,+IBIFN,"CP",+PROC,0)),U,2),".")
  1. I 'IBDAT S IBDAT=$P($P($G(^DGCR(399,+IBIFN,"U")),U,2),".")
  1. Q $S(IBDAT>0:IBDAT,1:"")
  1. ;
  1. ; === Coding System Implementation Date ===
  1. CSVDATE(IBSYS) ;
  1. N IBRES,IBINF S (IBRES,IBINF)=""
  1. I $G(IBSYS)'="" S IBINF=$$IMPDATE^LEXU(IBSYS)
  1. I IBINF>0 S IBRES=IBINF
  1. Q IBRES
  1. ;
  1. ; === PTF Date of Service ===
  1. PTFDATE(IBPTF) ;
  1. I '$G(IBPTF) Q ""
  1. Q $$GETDATE^ICDGTDRG(+$G(IBPTF))
  1. ;
  1. ; === Date of service, associated with the Tracking Number ===
  1. TRNDATE(IBTRN) ; The EPISODE DATE is used to determine the date of service
  1. ; for the given Tracking Number
  1. I '$G(IBTRN) Q ""
  1. Q $P($P($G(^IBT(356,+IBTRN,0)),U,6),".")
  1. ;
  1. ; === DRG Text Descriptor (1st line only) ===
  1. DRGTD(IEN,IBDT) ;
  1. N IBARR,IBRES
  1. S IBDT=$P($G(IBDT),".")
  1. I $T(DRGD^ICDGTDRG)="" Q $G(^ICD(+IEN,1,1,0))
  1. S IBRES=$$DRGD^ICDGTDRG(IEN,"IBARR",,IBDT)
  1. Q $G(IBARR(1))
  1. ;