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

IBTRD.m

Go to the documentation of this file. 
  1. IBTRD	;ALB/AAS - CLAIMS TRACKING - DENIAL/ APPEALS ; 10-AUG-1993
  1. 	;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
  1. 	;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. 	;
  1. %	;
  1. EN	; -- main entry point for IBT APPEAL/DENAIL EDITOR
  1. 	I '$D(DT) D DT^DICRW
  1. 	K XQORS,VALMEVL,IBTRD,DFN,IBCNS,IBTRN,IBTRV,IBTRC,IBFASTXT,VALMQUIT
  1. 	D ASK
  1. 	G:$D(VALMQUIT) ENQ
  1. 	I IBTRD["DPT(" S IBTYPE="P",DFN=+IBTRD D EN^VALM("IBT APPEAL/DENIAL EDITOR")
  1. 	I IBTRD["DIC(" S IBTYPE="I",IBCNS=+IBTRD D EN^VALM("IBT APPEAL/DENIAL INS EDITOR")
  1. ENQ	K XQORS,VALMEVL,IBTRD,DFN,IBCNS,IBTRN,IBTRV,IBTRC,IBFASTXT,VALMQUIT
  1. 	K IBAMT,IBAPR,IBADG,IBDA,IBDGCR,IBDGCRU1,IBDV,IBETYP,IBETYPD,IBI,IBICD,IBLCNT,IBSEL,IBT,IBTEXT,IBTNOD,IBTSAV,VAUTD
  1. 	K IBAPEAL,IBCDFN,IBCNT,IBDEN,IBDENIAL,IBDENIAL,IBPARNT,IBPEN,IBPENAL,IBTCOD,IBTRDD,IBTRSV,IBTYPE,VAINDT,VA,VALMBCK,OFFSET,I1,I3,IBNEW,IBDENT,IBOE,Z1,T,SDCNT
  1. 	D KVAR^VADPT
  1. 	Q
  1. 	;
  1. HDR	; -- header code
  1. 	I $G(IBTYPE)="P" D HDRP
  1. 	I $G(IBTYPE)="I" D HDRI
  1. 	Q
  1. 	;
  1. HDRI	; -- header code for by ins. co.
  1. 	S VALMHDR(1)="Denials and Appeals for: "_$P(^DIC(36,+IBCNS,0),"^")
  1. 	S VALMHDR(2)=" "
  1. 	Q
  1. 	;
  1. HDRP	; -- header code for by pat.
  1. 	D PID^VADPT
  1. 	S VALMHDR(1)="Denials and Appeals for: "_$$PT^IBTUTL1(DFN)
  1. 	S VALMHDR(2)=" "
  1. 	Q
  1. 	;
  1. INIT	; -- init variables and list array
  1. 	S U="^",VALMCNT=0,VALMBG=1
  1. 	K ^TMP("IBTRC",$J),^TMP("IBTRCDX",$J)
  1. 	K I,X,XQORNOD,DA,DR,DIE,DNM,DQ,IBTRC
  1. 	I '$G(IBTRD),$G(DFN) S IBTRD=DFN_";DPT("
  1. 	I '$G(IBTRD) S VALMQUIT=""
  1. 	S IBTRSV=""
  1. 	Q:$D(VALMQUIT)
  1. 	;
  1. BLD	; -- build list
  1. 	K ^TMP("IBTRD",$J),^TMP("IBTRDDX",$J)
  1. 	N IBI,J,IBTRC,IBTRCD,IBTRCD1,IBTRN
  1. 	I IBTRD["DPT(" S IBTYPE="P",DFN=+IBTRD D BLDP
  1. 	I IBTRD["DIC(" S IBTYPE="I",IBCNS=+IBTRD D BLDI
  1. 	Q
  1. 	;
  1. BLDI	; -- Build list of appeals/denials by ins. co.
  1. 	D HDRI
  1. 	S (IBTRC,IBCNT,VALMCNT)=0
  1. 	S IBDEN=$O(^IBE(356.7,"ACODE",20,0))
  1. 	S IBTRC=0 F  S IBTRC=$O(^IBT(356.2,"AIACT",IBCNS,IBDEN,IBTRC)) Q:'IBTRC  D 1
  1. 	S IBPEN=$O(^IBE(356.7,"ACODE",30,0))
  1. 	S IBTRC=0 F  S IBTRC=$O(^IBT(356.2,"AIACT",IBCNS,IBPEN,IBTRC)) Q:'IBTRC  D 1
  1. 	Q
  1. 	;
  1. BLDP	; -- Build list of appeals/denials by patient
  1. 	D HDRP
  1. 	S (IBTRC,IBCNT,VALMCNT)=0
  1. 	S VALMSG=$$MSG^IBTUTL3(DFN)
  1. 	S IBDEN=$O(^IBE(356.7,"ACODE",20,0))
  1. 	S IBTRC=0 F  S IBTRC=$O(^IBT(356.2,"APACT",DFN,IBDEN,IBTRC)) Q:'IBTRC  D 1
  1. 	S IBPEN=$O(^IBE(356.7,"ACODE",30,0))
  1. 	S IBTRC=0 F  S IBTRC=$O(^IBT(356.2,"APACT",DFN,IBPEN,IBTRC)) Q:'IBTRC  D 1
  1. 	Q
  1. 1	; -- first add denial, then add appeal
  1. 	S IBTRN=$P(^IBT(356.2,+IBTRC,0),"^",2)
  1. 	S IBTRSV=+IBTRC
  1. 	D 2
  1. 	N IBTRC,IBTRCD,IBTRCD1
  1. 	S IBAPEAL=$O(^IBE(356.11,"ACODE",60,0)) ; find appeals
  1. 	S IBTRC=0 F  S IBTRC=$O(^IBT(356.2,"AP",IBTRSV,IBTRC)) Q:'IBTRC  D 2
  1. 	;
  1. 	Q
  1. 2	; -- add items to list
  1. 	S IBTRCD=$G(^IBT(356.2,+IBTRC,0))
  1. 	S IBTRCD1=$G(^IBT(356.2,+IBTRC,1))
  1. 	Q:'+$P(IBTRCD,"^",19)  ;quit if inactive
  1. 	;
  1. 	; -- if not the denial, must be from parent
  1. 	I IBTRC'=IBTRSV&($P(IBTRCD,"^",18)'=IBTRSV) Q
  1. 	;
  1. 	S IBCNT=IBCNT+1
  1. 	W "."
  1. 	I IBTYPE="I" S DFN=$P(IBTRCD,"^",5) D PID^VADPT
  1. 	S X=""
  1. 	S X=$$SETFLD^VALM1(IBCNT,X,"NUMBER")
  1. 	;
  1. 	I IBTYPE="I" D
  1. 	.S X=$$SETFLD^VALM1($P(^DPT(DFN,0),"^"),X,"PATIENT")
  1. 	.S X=$$SETFLD^VALM1(VA("BID"),X,"ID")
  1. 	;
  1. 	I IBTYPE="P" D
  1. 	.S X=$$SETFLD^VALM1($P($G(^DIC(36,+$P(IBTRCD,"^",8),0)),"^"),X,"INS CO")
  1. 	.S X=$$SETFLD^VALM1($$GRP^IBCNS(+$P($G(^DPT(DFN,.312,+$P(IBTRCD1,"^",5),0)),"^",18)),X,"POLICY")
  1. 	;
  1. 	S X=$$SETFLD^VALM1($P($$DAT1^IBOUTL(+IBTRCD,"2P")," "),X,"DATE")
  1. 	I $P(IBTRCD,"^",11) S X=$$SETFLD^VALM1($$EXPAND^IBTRE(356.2,.11,$P(IBTRCD,"^",11)),X,"ACTION")
  1. 	I $P(IBTRCD,"^",11)="" S X=$$SETFLD^VALM1($P($G(^IBE(356.11,+$P(IBTRCD,"^",4),0)),"^",3),X,"ACTION")
  1. 	;
  1. 	S X=$$SETFLD^VALM1($P($G(^IBE(356.6,+$P(^IBT(356,+IBTRN,0),"^",18),0)),"^",2),X,"EVENT")
  1. 	S X=$$SETFLD^VALM1($$DAT1^IBOUTL(+$P(^IBT(356,+IBTRN,0),"^",6),"2P"),X,"EV DATE")
  1. 	S X=$$SETFLD^VALM1($$EXPAND^IBTRE(356.2,.04,$P(IBTRCD,"^",4)),X,"TYPE")
  1. 	S X=$$SETFLD^VALM1($J($$DAY^IBTUTL3($P(IBTRCD,"^",15),$P(IBTRCD,"^",16),IBTRN),3),X,"DAYS")
  1. 	S X=$$SETFLD^VALM1($$EXPAND^IBTRE(356,.31,$P(^IBT(356,IBTRN,0),"^",31)),X,"ROI")
  1. 	S X=$$SETFLD^VALM1($P(IBTRCD,"^",6),X,"CONTACT")
  1. 	S X=$$SETFLD^VALM1($P(IBTRCD,"^",7),X,"PHONE")
  1. 	S X=$$SETFLD^VALM1($P(IBTRCD,"^",9),X,"REF NO")
  1. 	D SET(X)
  1. 	Q
  1. 	;
  1. SET(X)	; -- set arrays
  1. 	S VALMCNT=VALMCNT+1
  1. 	S ^TMP("IBTRD",$J,VALMCNT,0)=X
  1. 	S ^TMP("IBTRD",$J,"IDX",VALMCNT,IBCNT)=""
  1. 	S ^TMP("IBTRDDX",$J,IBCNT)=VALMCNT_"^"_IBTRC
  1. 	Q
  1. HELP	; -- help code
  1. 	S X="?" D DISP^XQORM1 W !!
  1. 	Q
  1. 	;
  1. EXIT	; -- exit code
  1. 	K ^TMP("IBTRD",$J),^TMP("IBTRDDX",$J)
  1. 	D CLEAN^VALM10
  1. 	Q
  1. 	;
  1. ASK	; -- ask for patient or ins. co.
  1. 	N DIR
  1. 	S DIR(0)="350.9,4.02",DIR("A")="Select Patient Name or Insurance Co."
  1. 	D ^DIR K DIR I $D(DIRUT) S VALMQUIT="" G ASKQ
  1. 	S IBTRD=Y
  1. 	I +IBTRD<1 S VALMQUIT=""
  1. ASKQ	Q