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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBTRED2   1523     printed  Apr 09, 2024@21:25:06                                                                                                                                                                                                     Page 2

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