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

IBTRCD.m

Go to the documentation of this file. 
  1. IBTRCD ;ALB/AAS - CLAIMS TRACKING - EXPAND CONTACTS SCREEN ; 02-JUL-1993
  1.  ;;2.0;INTEGRATED BILLING;**210,458**;21-MAR-94;Build 4
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1. % ;
  1. EN ; -- main entry point for IBT EXPAND/EDIT COMMUNICATIONS
  1.  I '$D(DT) D DT^DICRW
  1.  K XQORS,VALMEVL,IBTRC,IBTRD,IBTRV,IBTRN,DFN
  1.  I '$G(IBTRC) G EN^IBTRC
  1.  D EN^VALM("IBT EXPAND/EDIT COMMUNICATIONS")
  1.  Q
  1.  ;
  1. HDR ; -- header code
  1.  D PID^VADPT N IBXR
  1.  S VALMHDR(1)="Expanded Insurance Reviews for: "_$$PT^IBTUTL1(DFN)
  1.  S IBXR=$$ROIEVT^IBTRR1(IBTRN) I IBXR'="" S VALMHDR(1)=VALMHDR(1)_$J(" ",(60-$L(VALMHDR(1))))_"ROI: "_IBXR
  1.  S VALMHDR(2)="                           for: "_$$EXPAND^IBTRE(356,.18,$P(IBTRND,"^",18))_" on "_$$DAT1^IBOUTL($P(IBTRND,"^",6),"2P")
  1.  Q
  1.  ;
  1. INIT ; -- init variables and list array
  1.  N IBTRCD,IBTRCD1
  1.  K VALMQUIT
  1.  S VALMCNT=0,VALMBG=1
  1.  D BLD,HDR
  1.  Q
  1.  ;
  1. BLD ; -- build display
  1.  K ^TMP("IBTRCD",$J),^TMP("IBTRCDDX",$J)
  1.  D KILL^VALM10()
  1.  S IBTRCD=$G(^IBT(356.2,IBTRC,0)),IBTRCD1=$G(^IBT(356.2,IBTRC,1))
  1.  S IBTRND=$G(^IBT(356,IBTRN,0))
  1.  F I=1:1:27 D BLANK^IBTRED(.I)
  1.  S VALMCNT=27
  1.  D ACTION,EN^IBTRCD0
  1.  Q
  1.  ;
  1.  ;
  1. ACTION ; -- Ins. Action infomation display
  1.  N OFFSET,START,TCODE,IBACTION,IBLCNT
  1.  S START=1,OFFSET=45,IBLCNT=0
  1.  D SET^IBCNSP(START,OFFSET," Action Information ",IORVON,IORVOFF)
  1.  D SET^IBCNSP(START+1,OFFSET,"   Type Contact: "_$$EXPAND^IBTRE(356.2,.04,$P(IBTRCD,"^",4)))
  1.  S TCODE=$$TCODE^IBTRC(IBTRC) I TCODE D @TCODE
  1.  Q
  1. 10 ; -- pre-cert contact
  1. 15 ; -- admission review
  1. 20 ; -- urgent/emergent ins. contact
  1. 25 ; -- snf/nhcu review
  1. 30 ; -- continued stay contact
  1. 35 ; -- inpt retrospective review
  1.  S IBLCNT=2
  1.  D SET^IBCNSP(START+IBLCNT,OFFSET,"         Action: "_$$EXPAND^IBTRE(356.2,.11,$P(IBTRCD,"^",11)))
  1.  S IBACTION=$P($G(^IBE(356.7,+$P(IBTRCD,"^",11),0)),"^",3)
  1.  S IBACTION=IBACTION+100 D @IBACTION
  1.  S IBLCNT=IBLCNT+1
  1.  Q
  1.  ;
  1. 40 ; -- Discharge contact
  1. 100 ; -- No type of action
  1.  Q
  1. 50 ; -- outpatient treatment
  1. 55 ; -- opt retrospective review
  1.  S IBLCNT=2
  1.  D SET^IBCNSP(START+IBLCNT,OFFSET," Opt Treatment: "_$$EXPAND^IBTRE(356.2,.26,$P(IBTRCD,"^",26)))
  1.  S IBLCNT=IBLCNT+1
  1.  D SET^IBCNSP(START+IBLCNT,OFFSET,"         Action: "_$$EXPAND^IBTRE(356.2,.11,$P(IBTRCD,"^",11)))
  1.  S IBLCNT=IBLCNT+1
  1.  D SET^IBCNSP(START+IBLCNT,OFFSET,"   Auth. Number: "_$$AUTHN^IBTRC(IBTRC,18))
  1.  ;D SET^IBCNSP(START+IBLCNT,OFFSET,"Treatment Auth: "_$$EXPAND^IBTRE(356.2,.27,$P(IBTRCD,"^",27)))
  1.  Q
  1. 60 ; -- Appeal
  1. 65 ; -- Nth appeal
  1.  D SET^IBCNSP(START+2,OFFSET,"    Appeal Type: "_$$EXPAND^IBTRE(356.2,.23,$P(IBTRCD,"^",23)))
  1.  D SET^IBCNSP(START+3,OFFSET,"    Case Status: "_$$EXPAND^IBTRE(356.2,.1,$P(IBTRCD,"^",10)))
  1.  D SET^IBCNSP(START+4,OFFSET,"No Days Pending: "_$$EXPAND^IBTRE(356.2,.25,$P(IBTRCD,"^",25)))
  1.  D SET^IBCNSP(START+5,OFFSET,"  Final Outcome: "_$$EXPAND^IBTRE(356.2,.29,$P(IBTRCD,"^",29)))
  1.  Q
  1. 70 ; -- Patient
  1. 80 ; -- Other
  1. 85 ; -- Insurance verification
  1.  Q
  1.  ;
  1. 110 ; -- approval actions
  1.  S IBLCNT=IBLCNT+1
  1.  D SET^IBCNSP(START+IBLCNT,OFFSET,"Authorized From: "_$S($P(IBTRCD1,"^",8):"ENTIRE VISIT",1:$$DAT1^IBOUTL($P(IBTRCD,"^",12))))
  1.  S IBLCNT=IBLCNT+1
  1.  D SET^IBCNSP(START+IBLCNT,OFFSET,"  Authorized To: "_$S($P(IBTRCD1,"^",8):"ENTIRE VISIT",1:$$DAT1^IBOUTL($P(IBTRCD,"^",13))))
  1.  S IBLCNT=IBLCNT+1
  1.  D SET^IBCNSP(START+IBLCNT,OFFSET,"Authorized Diag: "_$$DIAG^IBTRE6($P(IBTRCD,"^",14),1,$$TRNDATE^IBACSV($G(IBTRN))))
  1.  S IBLCNT=IBLCNT+1
  1.  D SET^IBCNSP(START+IBLCNT,OFFSET,"   Auth. Number: "_$$AUTHN^IBTRC(IBTRC,18))
  1.  Q
  1. 120 ; -- denial actions
  1.  S IBLCNT=IBLCNT+1
  1.  D SET^IBCNSP(START+IBLCNT,OFFSET,"    Denied From: "_$S($P(IBTRCD1,"^",7):"ENTIRE VISIT",1:$$DAT1^IBOUTL($P(IBTRCD,"^",15))))
  1.  S IBLCNT=IBLCNT+1
  1.  D SET^IBCNSP(START+IBLCNT,OFFSET,"      Denied To: "_$S($P(IBTRCD1,"^",7):"ENTIRE VISIT",1:$$DAT1^IBOUTL($P(IBTRCD,"^",16))))
  1.  S IBI=0 F  S IBI=$O(^IBT(356.2,IBTRC,12,IBI)) Q:'IBI!(IBLCNT>6)  D
  1.  .S IBLCNT=IBLCNT+1
  1.  .D SET^IBCNSP(START+IBLCNT,OFFSET," Denial Reasons: "_$$EXPAND^IBTRE(356.212,.01,+$G(^IBT(356.2,IBTRC,12,IBI,0))))
  1.  Q
  1. 130 ; -- penalty
  1.  S IBI=0 F  S IBI=$O(^IBT(356.2,IBTRC,13,IBI)) Q:'IBI!(IBLCNT>6)  D
  1.  .S IBLCNT=IBLCNT+1
  1.  .D SET^IBCNSP(START+IBLCNT,OFFSET,"        Penalty: "_$$EXPAND^IBTRE(356.213,.01,+$G(^IBT(356.2,IBTRC,13,IBI,0))))
  1.  Q
  1. 140 ; -- case pending
  1.  S IBLCNT=IBLCNT+1
  1.  D SET^IBCNSP(START+IBLCNT,OFFSET,"   Case Pending: "_$$EXPAND^IBTRE(356.2,.2,$P(IBTRCD,"^",20)))
  1.  Q
  1. 150 ; -- no coverage
  1.  S IBLCNT=IBLCNT+1
  1.  D SET^IBCNSP(START+IBLCNT,OFFSET,"    No Coverage: "_$$EXPAND^IBTRE(356.2,.21,$P(IBTRCD,"^",21)))
  1.  Q
  1.  ;
  1.  ;
  1. HELP ; -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  K VALMQUIT,IBTRC,IBTRCD,IBTRCD1
  1.  K ^TMP("IBTRCD",$J),^TMP("IBTRCDDX",$J)
  1.  D CLEAN^VALM10,FULL^VALM1
  1.  Q