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

IBTRKR41.m

Go to the documentation of this file. 
  1. IBTRKR41 ;ALB/AAS - CLAIMS TRACKING - ADD/TRACK OUTPATIENT ENCOUNTERS ;13-AUG-93
  1.  ;;2.0;INTEGRATED BILLING;**43,55,91,132,174,247,260,315,292,312,339,399**;21-MAR-94;Build 8
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1. OPCHK ; -- check and add rx
  1.  N Y,Y0,IBSERV,IBAPPT
  1.  N IBSWINFO S IBSWINFO=$$SWSTAT^IBBAPI()                   ;IB*2.0*312
  1.  ; IBDT is set from IBTRKR4
  1.  ; Do NOT PROCESS on VistA if IBDT>=Switch Eff Date        ;CCR-930
  1.  I +IBSWINFO,(IBDT+1)>$P(IBSWINFO,"^",2) Q                 ;IB*2.0*312
  1.  ;
  1.  K IBRMARK
  1.  I '$D(ZTQUEUED),($G(IBTALK)) W "."
  1.  ;
  1.  S IBOEDATA=$$SCE^IBSDU(IBOE),IBOESTAT=$P(IBOEDATA,"^",15)
  1.  S IBSERV=$S(+$P($G(^DIC(40.7,+$P(IBOEDATA,"^",3),0)),"^",2)=180:"DENTAL",1:"OUTPATIENT")
  1.  S IBAPPT=$P($G(^SD(409.1,+$P(IBOEDATA,"^",10),0)),"^",1)
  1.  S DFN=$P(IBOEDATA,"^",2)
  1.  I 'DFN G OPCHKQ
  1.  I $P(IBOEDATA,"^",5) S IBVSIT=$P(IBOEDATA,"^",5) I '$$BDSRC^IBEFUNC3(IBVSIT) G OPCHKQ ;non-billable data sources
  1.  ; -- do not allow date/time duplicate claims before Jan. 1, 2006
  1.  I $O(^IBT(356,"APTY",DFN,IBOETYP,IBDT,0)),IBDT<3060101 G OPCHKQ
  1.  ;
  1.  ; -- see if tracking only insured and pt is insured/insured for outpt visits
  1.  I $P(IBTRKR,"^",3)=1,'$$INSURED^IBCNS1(DFN,IBDT) G OPCHKQ ; patient not insured
  1.  ;
  1.  I '$$PTFTF^IBCNSU31(DFN,IBDT) S IBRMARK="FILING TIMEFRAME NOT MET"
  1.  ;
  1.  ; -- see if outpatient services are covered
  1.  I '$$PTCOV^IBCNSU3(DFN,IBDT,IBSERV,.IBANY) S IBRMARK=$S($G(IBANY)&(IBSERV="DENTAL"):"NO DENTAL COVERAGE",$G(IBANY):"NO OUTPATIENT COVERAGE",1:"NOT INSURED")
  1.  ;
  1.  ; -- see if appointment type is billable
  1.  I '$$RPT^IBEFUNC($P(IBOEDATA,"^",10),+IBOEDATA) S IBRMARK=$S(IBAPPT="RESEARCH":"RESEARCH VISIT",1:"NON-BILLABLE APPOINTMENT TYPE")
  1.  ;
  1.  ; -- check sc status, special conditions etc.
  1.  I $G(IBRMARK)="" S IBRMARK=$$CL(IBOEDATA)
  1.  ;
  1.  ; -- check for non-billable stops or clinic
  1.  S X=$P(IBOEDATA,"^",4) I X,$$NBCT^IBEFUNC(X,+IBOEDATA) S IBRMARK="NON-BILLABLE CLINIC"
  1.  S X=$P(IBOEDATA,"^",3) I X,$$NBST^IBEFUNC(X,+IBOEDATA) S IBRMARK="NON-BILLABLE STOP CODE"
  1.  ;
  1.  ; -- ok to add to tracking module
  1.  D OPT^IBTUTL1(DFN,IBOETYP,IBDT,IBOE,IBRMARK,$G(IBVSIT)) I '$D(ZTQUEUED),$G(IBTALK) W "+"
  1.  I IBRMARK'="" S IBCNT2=IBCNT2+1
  1.  I IBRMARK="" S IBCNT1=IBCNT1+1
  1. OPCHKQ K IBANY,IBRMARK,VAEL,VA,IBOEDATA,IBVSIT,DFN,X,Y
  1.  Q
  1.  ;
  1. BULL ; -- send bulletin
  1.  ;
  1.  S XMSUB="Outpatient Encounters added to Claims Tracking Complete"
  1.  S IBT(1)="The process to automatically add Opt Encounters has successfully completed."
  1.  S IBT(1.1)=""
  1.  S IBT(2)="              Start Date: "_$$DAT1^IBOUTL(IBTSBDT)
  1.  S IBT(3)="                End Date: "_$$DAT1^IBOUTL(IBTSEDT)
  1.  I $D(IBMESS) S IBT(3.1)=IBMESS
  1.  S IBT(4)=""
  1.  S IBT(5)="            Total Encounters Checked: "_$G(IBCNT)
  1.  S IBT(6)="              Total Encounters Added: "_$G(IBCNT1)
  1.  S IBT(7)=" Total Non-billable Encounters Added: "_$G(IBCNT2)
  1.  S IBT(8)=""
  1.  S IBT(9)="*The SC, Agent Orange, Southwest Asia, Ionizing Radiation,"
  1.  S IBT(10)="Military Sexual Trauma, Head Neck Cancer, Combat Veteran and Project 112/SHAD"
  1.  S IBT(11)="status visits have been added for insured patients but automatically"
  1.  S IBT(12)="indicated as not billable."
  1.  D SEND^IBTRKR31
  1. BULLQ Q
  1.  ;
  1. CL(IBOEDATA,IBR) ; check out classification questions for encounter
  1.  ; this new check will look at the V POV level then to the Visit level
  1.  ; as necessary to determine if it relates or not.  This will indicate
  1.  ; if the WHOLE visit is not billable, otherwise it will say it is
  1.  ; (even if just part is billable).
  1.  ; call with the zero node of 409.68 in IBOEDATA
  1.  ; assumes DFN and IBDT defined
  1.  ; pass in IBR by ref to get values back
  1.  ;
  1.  N IBRMARK,IBPCEX,IBCPT,IBARR,IBP,IBDX,IBVRNB,IBENCL
  1.  S IBRMARK="",IBPCEX=$P(IBOEDATA,"^",5)
  1.  ;
  1.  ; look up classification info needed (if any)
  1.  D CL^SDCO21(DFN,IBDT,"",.IBARR) I '$D(IBARR) G CLQ
  1.  ;
  1.  ; if no PCE event use old approach
  1.  I 'IBPCEX D:$G(IBOE)  G CLQ
  1.  . S IBENCL=$$ENCL^IBAMTS2(IBOE) I IBENCL["1" D  ; return 1 in string if true "ao^ir^sc^swa^mst^hnc^cv^shad"
  1.  . I $P(IBENCL,"^",3) S IBRMARK="SC TREATMENT" Q
  1.  . I $P(IBENCL,"^",1) S IBRMARK="AGENT ORANGE" Q
  1.  . I $P(IBENCL,"^",2) S IBRMARK="IONIZING RADIATION" Q
  1.  . I $P(IBENCL,"^",4) S IBRMARK="SOUTHWEST ASIA" Q
  1.  . I $P(IBENCL,"^",5) S IBRMARK="MILITARY SEXUAL TRAUMA" Q
  1.  . I $P(IBENCL,"^",6) S IBRMARK="HEAD/NECK CANCER" Q
  1.  . I $P(IBENCL,"^",7) S IBRMARK="COMBAT VETERAN" Q
  1.  . I $P(IBENCL,"^",8) S IBRMARK="PROJECT 112/SHAD" Q
  1.  ;
  1.  ; look up PCE info
  1.  D ENCEVENT^PXKENC(IBPCEX)
  1.  ;
  1.  S IBVRNB=$$RNB($G(^TMP("PXKENC",$J,IBPCEX,"VST",IBPCEX,800)),.IBARR)
  1.  ;
  1.  ; find dx rnb's
  1.  S IBDX=0 F  S IBDX=$O(^TMP("PXKENC",$J,IBPCEX,"POV",IBDX)) Q:'IBDX  S IBDX(+$G(^TMP("PXKENC",$J,IBPCEX,"POV",IBDX,0)))=$$RNB($G(^TMP("PXKENC",$J,IBPCEX,"POV",IBDX,800)),.IBARR)
  1.  ;
  1.  ; look for v cpt's with IBDX
  1.  S IBCPT=0 F  S IBCPT=$O(^TMP("PXKENC",$J,IBPCEX,"CPT",IBCPT)) Q:'IBCPT  F IBP=5,9,10,11 Q:'$D(^TMP("PXKENC",$J,IBPCEX,"CPT",IBCPT,0))  D
  1.  . ;
  1.  . ; dx exists in v cpt but not v pov use visit level determination
  1.  . I $P(^TMP("PXKENC",$J,IBPCEX,"CPT",IBCPT,0),"^",IBP),'$D(IBDX($P(^TMP("PXKENC",$J,IBPCEX,"CPT",IBCPT,0),"^",IBP))) D:IBVRNB REL(IBVRNB) Q
  1.  . ;
  1.  . ; use dx determination (where dx exists on v cpt)
  1.  . I $P(^TMP("PXKENC",$J,IBPCEX,"CPT",IBCPT,0),"^",IBP) D:$G(IBDX($P(^TMP("PXKENC",$J,IBPCEX,"CPT",IBCPT,0),"^",IBP))) REL($G(IBDX($P(^TMP("PXKENC",$J,IBPCEX,"CPT",IBCPT,0),"^",IBP)))) Q
  1.  ;
  1.  ; check for no assoc dx and apply visit level determination
  1.  S IBCPT=0 F  S IBCPT=$O(^TMP("PXKENC",$J,IBPCEX,"CPT",IBCPT)) Q:'IBCPT  D
  1.  . S IBDX=0 F IBP=5,9,10,11 Q:IBDX  I +$P($G(^TMP("PXKENC",$J,IBPCEX,"CPT",IBCPT,0)),"^",IBP) S IBDX=1
  1.  . I 'IBDX,IBVRNB D REL(IBVRNB)
  1.  ;
  1.  ; if some procedures left, then we need to bill, set return array
  1.  I $D(^TMP("PXKENC",$J,IBPCEX,"CPT")) S IBRMARK="" M IBR=^TMP("PXKENC",$J,IBPCEX)
  1.  ;
  1. CLQ K ^TMP("PXKENC",$J)
  1.  Q IBRMARK
  1.  ;
  1. RNB(IBDATA,IBARR) ; find rnb's
  1.  ; pass in PCE 800 data (visit or v pov) to find any reasons not billalbe
  1.  ; IBARR = classifications that could apply to patient
  1.  ; the RNB number returned is from the IBARR number (SDCO21 array)
  1.  N IBX,IBR S IBR=""
  1.  S IBX=0 F  S IBX=$O(IBARR(IBX)) Q:'IBX!(IBR)  I $P(IBDATA,"^",$P($T(CLDATA+(IBX+1)),"^",2)) S IBR=IBX
  1.  Q IBR
  1.  ;
  1. REL(IBRNB) ; kills of tmp if related and set IBRMARK
  1.  K ^TMP("PXKENC",$J,IBPCEX,"CPT",IBCPT)
  1.  S IBRMARK=$P($T(CLDATA+(IBRNB+1)),"^",3)
  1.  Q
  1.  ;
  1. CLDATA ; classification data
  1.  ; format is:  SCDO21 array^vpov/vcpt/visit 800 piece^reason not billable
  1.  ;;1^2^AGENT ORANGE
  1.  ;;2^3^IONIZING RADIATION
  1.  ;;3^1^SC TREATMENT
  1.  ;;4^4^SOUTHWEST ASIA
  1.  ;;5^5^MILITARY SEXUAL TRAUMA
  1.  ;;6^6^HEAD/NECK CANCER
  1.  ;;7^7^COMBAT VETERAN
  1.  ;;8^8^PROJECT 112/SHAD
  1.  ;