IBTRED2.m

IBTRED2	;ALB/AAS - CLAIMS TRACKING EDIT BILLING INFORMATION; 06-JUL-93

	;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

	;;Per VHA Directive 10-93-142, this routine should not be modified.

	;

%	I '$D(DT) D DT^DICRW

	I '$D(IOF) D HOME^%ZIS

	W @IOF,?15,"Assign Reason Not Billable to Claims Tracking Entry",!!

	S IBQUIT=0

	;

PAT	; -- select patient

	D END Q:IBQUIT

	D PAT^IBCNSM I '$G(DFN)!($D(VALMQUIT)) G END

	;

CT	; -- select claims tracking entry

	D TRAC^IBTRV

	I +IBY<1 D ADD G:IBQUIT END

	I '$G(IBTRN) G PAT

	D EDIT("[IBT BILLING INFO]")

	W !!

	G PAT

	;

END	K DFN,VALMQUIT,IBY,IBTRN

	Q

	;

EDIT(IBTEMP)	; -- edit without list manager

	; -- Input   IBTEMP = template name or dr string

	;

	N X,Y,I,J,DA,DR,DIC,DIE

	G:$G(IBTRN)<1 EDITQ

	L +^IBT(356,+IBTRN):5 I '$T D LOCKED^IBTRCD1 G EDITQ

	D SAVE^IBTRED1

	S DIE="^IBT(356,",DA=IBTRN

	S DR=IBTEMP

	D ^DIE

	D COMP^IBTRED1

	I IBDIF=1 D UPDATE^IBTRED1

	L -^IBT(356,+IBTRN)

EDITQ	K ^TMP($J,"IBT")

	Q

	;

ADD	; -- ask if want to add a new tracking id

	N DIR,IBOK K IBTRN

	G:'$D(DFN) ADDQ

	W !

	S DIR(0)="Y",DIR("A")="Add New Claims Tracking entry",DIR("B")="NO"

	S DIR("?")="Enter 'YES' if you wish to add a new claims tracking entry so that it can be assigned a reason not billable, answer 'NO' if you do not wish to add a new entry."

	D ^DIR K DIR S IBOK=Y

	G:'IBOK ADDQ

	;

	; -- set up required variable before call

	S IBTASS=1

	S IBTBDT=$$FMADD^XLFDT(DT,-720),IBTEDT=$$FMADD^XLFDT(DT,+45)

	W !

	D TEST^IBTRE2

ADDQ	W ! Q

IBTRED2   ;ALB/AAS - CLAIMS TRACKING EDIT BILLING INFORMATION; 06-JUL-93

 +1       ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;

%          IF '$DATA(DT)

               DO DT^DICRW

 +1        IF '$DATA(IOF)

               DO HOME^%ZIS

 +2        WRITE @IOF,?15,"Assign Reason Not Billable to Claims Tracking Entry",!!

 +3        SET IBQUIT=0

 +4       ;

PAT       ; -- select patient

 +1        DO END

           IF IBQUIT

               QUIT 

 +2        DO PAT^IBCNSM

           IF '$GET(DFN)!($DATA(VALMQUIT))

               GOTO END

 +3       ;

CT        ; -- select claims tracking entry

 +1        DO TRAC^IBTRV

 +2        IF +IBY<1

               DO ADD

               IF IBQUIT

                   GOTO END

 +3        IF '$GET(IBTRN)

               GOTO PAT

 +4        DO EDIT("[IBT BILLING INFO]")

 +5        WRITE !!

 +6        GOTO PAT

 +7       ;

END        KILL DFN,VALMQUIT,IBY,IBTRN

 +1        QUIT 

 +2       ;

EDIT(IBTEMP) ; -- edit without list manager

 +1       ; -- Input   IBTEMP = template name or dr string

 +2       ;

 +3        NEW X,Y,I,J,DA,DR,DIC,DIE

 +4        IF $GET(IBTRN)<1

               GOTO EDITQ

 +5        LOCK +^IBT(356,+IBTRN):5

           IF '$TEST

               DO LOCKED^IBTRCD1

               GOTO EDITQ

 +6        DO SAVE^IBTRED1

 +7        SET DIE="^IBT(356,"

           SET DA=IBTRN

 +8        SET DR=IBTEMP

 +9        DO ^DIE

 +10       DO COMP^IBTRED1

 +11       IF IBDIF=1

               DO UPDATE^IBTRED1

 +12       LOCK -^IBT(356,+IBTRN)

EDITQ      KILL ^TMP($JOB,"IBT")

 +1        QUIT 

 +2       ;

ADD       ; -- ask if want to add a new tracking id

 +1        NEW DIR,IBOK

           KILL IBTRN

 +2        IF '$DATA(DFN)

               GOTO ADDQ

 +3        WRITE !

 +4        SET DIR(0)="Y"

           SET DIR("A")="Add New Claims Tracking entry"

           SET DIR("B")="NO"

 +5        SET DIR("?")="Enter 'YES' if you wish to add a new claims tracking entry so that it can be assigned a reason not billable, answer 'NO' if you do not wish to add a new entry."

 +6        DO ^DIR

           KILL DIR

           SET IBOK=Y

 +7        IF 'IBOK

               GOTO ADDQ

 +8       ;

 +9       ; -- set up required variable before call

 +10       SET IBTASS=1

 +11       SET IBTBDT=$$FMADD^XLFDT(DT,-720)

           SET IBTEDT=$$FMADD^XLFDT(DT,+45)

 +12       WRITE !

 +13       DO TEST^IBTRE2

ADDQ       WRITE !

           QUIT