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

IBTRC1.m

Go to the documentation of this file. 
  1. IBTRC1	;ALB/AAS - CLAIMS TRACKING -  INSURANCE ACTIONS ACTIONS ; 14-JUL-93
  1. 	;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
  1. 	;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. 	;
  1. %	G EN^IBTRC
  1. 	;
  1. AI	; -- Add ins. Action entry
  1. 	N X,Y,I,J,DA,DR,DIC,DIE,DR,DD,DO,IBQUIT,IBTRCDT,DIR,DIRUT,DUOUT
  1. 	;
  1. 	; -- select date
  1. 	S DIR(0)="356.2,.01",DIR("A")="Select Insurance Review or Contact Date",DIR("B")="NOW"
  1. 	D ^DIR K DIR
  1. 	I $D(DIRUT)!($D(DUOUT))!(+Y<1) G AIQ
  1. 	S IBTRCDT=+Y
  1. 	;
  1. 	; -- if not tracking id allow selecting
  1. 	I '$G(IBTRN) D
  1. 	.S DIC="^IBT(356,",DIC(0)="AEQ",D="ADFN"_DFN
  1. 	.D IX^DIC K DIC
  1. 	.I +Y>1 S IBTRN=+Y
  1. 	;
  1. 	; -- add entry
  1. 	D COM^IBTUTL3(IBTRCDT,$G(IBTRN),"",$G(IBTRV))
  1. 	;
  1. 	; -- edit based on type/action
  1. 	D QE1
  1. 	D BLD^IBTRC
  1. 	S VALMBCK="R"
  1. AIQ	Q
  1. 	;
  1. DT	; -- Delete Insurance Action entry
  1. 	I '$D(^XUSEC("IB CLAIMS SUPERVISOR",DUZ)) D SORRY^IBTRE1 G DTQ
  1. 	N I,J,IBXX,DIR,DIRUT,VALMY
  1. 	D EN^VALM2($G(XQORNOD(0)))
  1. 	I $D(VALMY) D FULL^VALM1 S IBXX=0 F  S IBXX=$O(VALMY(IBXX)) Q:'IBXX!$D(DIRUT)  D
  1. 	.S IBTRC=$P($G(^TMP("IBTRCDX",$J,+$O(^TMP("IBTRC",$J,"IDX",IBXX,0)))),"^",2)
  1. 	.I $O(^IBT(356.2,"AP",IBTRC,0)) W !,"Must first delete appeals associated with Denials" D PAUSE^VALM1 Q
  1. 	.;
  1. 	.W ! S DIR(0)="Y",DIR("B")="NO",DIR("A")="Are You Sure you want to delete entry #"_IBXX
  1. 	.D ^DIR I Y'=1 W !,"Entry #",IBXX," not Deleted!" Q
  1. 	.D DP1
  1. 	.Q
  1. DTQ	D BLD^IBTRC
  1. 	S VALMBCK="R" Q
  1. 	;
  1. DP1	; -- actual deletion
  1. 	N DA,DIC,DIK
  1. 	;
  1. 	; -- delete reviews, communications,
  1. 	S DA=IBTRC,DIK="^IBT(356.2," D ^DIK
  1. 	W !,"Entry ",IBXX," Deleted!"
  1. 	Q
  1. 	;
  1. QE	; -- Quick edit Review entry
  1. 	N I,J,IBXX,VALMY
  1. 	D EN^VALM2($G(XQORNOD(0)))
  1. 	I $D(VALMY) S IBXX=0 F  S IBXX=$O(VALMY(IBXX)) Q:'IBXX  D
  1. 	.S IBTRC=$P($G(^TMP("IBTRCDX",$J,+$O(^TMP("IBTRC",$J,"IDX",IBXX,0)))),"^",2)
  1. 	.D QE1
  1. QEQ	S VALMBCK="R"
  1. 	D BLD^IBTRC
  1. 	Q
  1. 	;
  1. QE1	N X,Y,DA,DR,DIC,DIE,IBSEL,IBTLST
  1. 	D EDIT^IBTRCD1("[IBT QUICK EDIT]",1)
  1. 	Q
  1. 	I $$TRTP^IBTRE1(IBTRN)<3 D  ;clinical info only on inpt/outpt
  1. 	.; -- diagnosis edit
  1. 	.D EN^IBTRE3(IBTRN) Q:$G(IBSEL)["^"
  1. 	.;
  1. 	.; -- procedure edit / only inpt. / outpt use add/edit
  1. 	.I $$TRTP^IBTRE1(IBTRN)<2 D EN^IBTRE4(IBTRN) Q:$G(IBSEL)["^"
  1. 	.;
  1. 	.; -- provider edit
  1. 	.D EN^IBTRE5(IBTRN)
  1. 	Q
  1. 	;
  1. NX(IBTMPNM)	; -- Go to next template
  1. 	; -- Input template name
  1. 	N I,J,IBXXC,VALMY
  1. 	S IBTSAV("IBTRN")=IBTRN
  1. 	D EN^VALM2($G(XQORNOD(0)))
  1. 	I $D(VALMY) S IBXXC=0 F  S IBXXC=$O(VALMY(IBXXC)) Q:'IBXXC  D
  1. 	.S IBTRC=$P($G(^TMP("IBTRCDX",$J,+$O(^TMP("IBTRC",$J,"IDX",IBXXC,0)))),"^",2)
  1. 	.D EN^VALM(IBTMPNM)
  1. 	.K IBAMT,IBAPR,IBADG,IBDA,IBDGCR,IBDGCRU1,IBDV,IBETYP,IBETYPD,IBI,IBICD,IBLCNT,IBSEL,IBT,IBTEXT,IBTNOD,VAUTD
  1. 	.K IBAPEAL,IBCDFN,IBCNT,IBDEN,IBDENIAL,IBDENIAL,IBPARNT,IBPEN,IBPENAL,IBTCOD,IBTRDD,IBTRSV,IBTYPE,VAINDT,VA
  1. 	.D KVAR^VADPT
  1. 	.Q
  1. 	S IBTRN=$G(IBTSAV("IBTRN"))
  1. 	I '$D(IBFASTXT) D BLD^IBTRC
  1. 	S VALMBCK="R"
  1. 	Q
  1. 	;
  1. EDIT(IBTEMP)	; -- Edit entries
  1. 	N I,J,IBXX,VALMY
  1. 	D EN^VALM2($G(XQORNOD(0)))
  1. 	I $D(VALMY) D FULL^VALM1 S IBXX=0 F  S IBXX=$O(VALMY(IBXX)) Q:'IBXX  D
  1. 	.S IBTRC=$P($G(^TMP("IBTRCDX",$J,+$O(^TMP("IBTRC",$J,"IDX",IBXX,0)))),"^",2)
  1. 	.W !!,"Editing Entry #",IBXX,!
  1. 	.D EDIT^IBTRCD1(IBTEMP,1)
  1. 	S VALMBCK="R"
  1. 	D BLD^IBTRC
  1. 	Q
  1. 	;
  1. PRECRT(IBTRN)	; -- find precert number for a tracking entry
  1. 	; -- input ibtrn = internal entry of tracking id.
  1. 	;
  1. 	S PRECERT=""
  1. 	I '$G(IBTRN) G PRECQ
  1. 	S PRECERT=$O(^IBT(356.2,"APRE",IBTRN,0))
  1. PRECQ	Q PRECERT
  1. 	;
  1. SHOWSC	; -- display sc conditions
  1. 	N VAEL,TAB,IBTRCSC
  1. 	D FULL^VALM1
  1. 	D ELIG^VADPT
  1. 	W !!,"Patient: ",$$PT^IBTUTL1(DFN)
  1. 	I 'VAEL(3) W !,"Patient Not Service Connected",!! G SHOWQ
  1. 	W !,?5,"Service Connected Percent: "_+$P(VAEL(3),"^",2)_"%"
  1. 	S TAB=5,IBTRCSC=1 D SC^IBTOAT2
  1. SHOWQ	D PAUSE^VALM1
  1. 	S VALMBCK="R"
  1. 	Q
  1. 	;
  1. CP	; -- change patient from within insurance reviews
  1. 	N VALMQUIT,IBDFN,IBTRNOLD,IBY
  1. 	D FULL^VALM1
  1. 	S IBDFN=DFN D PAT^IBCNSM
  1. 	I $D(VALMQUIT) S DFN=IBDFN
  1. 	S IBTRNOLD=IBTRN K IBTRN
  1. 	D TRAC^IBTRV
  1. 	I '$G(IBTRN) S DFN=IBDFN,IBTRN=IBTRNOLD
  1. 	S IBTRND=$G(^IBT(356,+IBTRN,0))
  1. 	D BLD^IBTRC,HDR^IBTRC
  1. 	S VALMBCK="R"
  1. CPQ	Q
  1. 	;
  1. SCREEN(ACODE,CTYPE)	; -- screen for action field of file 356.2
  1. 	; -- called by input transform
  1. 	;    input  ACODE = piece 3 (action code) of entry being screen in 356.7
  1. 	;           CTYPE = type of review, pointer to 356.11
  1. 	;
  1. 	S CTYPE=$P($G(^IBE(356.11,+CTYPE,0)),"^",2) I 'CTYPE Q 1
  1. 	Q $S(CTYPE=10:1,CTYPE=20:1,CTYPE=30:1,CTYPE=50&(ACODE<30):1,1:0)
  1. 	;Q $S(CTYPE=1:1,CTYPE=2&(ACODE'=30):1,CTYPE=3:1,CTYPE=5&(ACODE<30):1,1:0)