Routine: IBEMTO

IBEMTO	;ALB/CPM - BILL MT CHARGES AWAITING NEW COPAY RATE ; 02-AUG-93

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

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

	; Bill MT OPT charges on hold awaiting the new copay rate.

ENO	; Standalone option entry point

	S IBOPT=1

ENR	; Enter/edit billing rates entry point

	; - quit if job has been fired up from enter/edit rates already

	I $G(IBRUN) G ENQ

	; - quit if there are no charges on hold awaiting the new rate

	I '$D(^IB("AC",20)) W:$G(IBOPT) !!,"There are no charges on hold awaiting the entry of the new copay rate." G ENQ

	; - quit if current rate is still too old

	S IBDT=DT,IBX="O" D TYPE^IBAUTL2

	I $$OLDRATE^IBAMTS1(IBRTED,DT) D:$G(IBOPT)  G ENQ

	.W !!,"The current copay rate (effective ",$$DAT1^IBOUTL(IBRTED),") is still too old to use.  Please be"

	.W !,"sure that you have entered the most current rate in your Billing Rates table."

	; - if x-ref is locked, the job must be currently running

	L +^IB("AC",20):5 E  D:$G(IBOPT)  G ENQ

	.W !!,"The list of held charges cannot be accessed -- the job to bill these held"

	.W !,"charges may currently be running."

	; - queue the job to bill the held charges?

	I '$G(IBOPT) D

	.W !!?28,*7,*7,"***  PLEASE NOTE  ***"

	.W !?8,"The Means Test Outpatient Copayment rate has just been updated,"

	.W !?8,"and there are charges 'on hold' awaiting the entry of this new rate!",!

	I $G(IBOPT) D

	.S IBN=0 F IBJ=0:1:21 S IBN=$O(^IB("AC",20,IBN)) Q:'IBN

	.W !!,"There ",$S(IBJ=1:"is 1",1:"are "_$S(IBJ>20:"at least ",1:"")_IBJ)," charge",$E("s",IBJ>1)," on hold, awaiting the new copay rate."

	S DIR(0)="Y",DIR("A")="Do you want to queue a job to automatically bill these held charges",DIR("?")="^D HQ^IBEMTO"

	D ^DIR K DIR I 'Y!($D(DIRUT))!($D(DUOUT)) G ENQ

	; - queue up job to bill held charges

	S:'$G(IBOPT) ZTDTH=$H

	S ZTRTN="DQ^IBEMTO",ZTIO="",ZTDESC="BILLING OF MT OPT CHARGES AWAITING NEW COPAY RATE"

	S IBRUN=1 D ^%ZTLOAD W !!,$S($D(ZTSK):"This job has been queued.  The task number is "_ZTSK_".",1:"Unable to queue this job!")

ENQ	L -^IB("AC",20)

	K:$G(IBOPT) IBRUN

	K IBN,IBDT,IBATYP,IBDESC,IBJ,IBOPT,IBRTED,IBCHG,IBX,ZTSK

HQ	; Help for prompt

	W !!,"If you wish to queue off a job to bill the Means Test Outpatient"

	W !,"copayment charges that are on hold awaiting entry of the updated"

	W !,"billing rate, please enter 'Y' or 'YES'.  The job will be tasked"

	W !,"immediately.  Otherwise, enter 'N' or 'NO' or '^' to quit."

DQ	; Tasked job to bill all charges awaiting the new copay rate.

	S IBJOB=8,IBDUZ=DUZ,IBSEQNO=1,IBCNT=0

	; - record start time

	D NOW^%DTC S IBSTART=$$DAT2^IBOUTL(%)

	; - if can't lock x-ref, job must currently be running

	L +^IB("AC",20):5

	; - loop through all charges awaiting the new rate

	I  S IBREF=0 F  S IBREF=$O(^IB("AC",20,IBREF)) Q:'IBREF  D CHG

	; - unlock x-ref, record end time, and post bulletin

	L -^IB("AC",20)

	D NOW^%DTC S IBEND=$$DAT2^IBOUTL(%)

	D BULL^IBEMTO1

	K IBT,IBSTART,IBEND,IBREF,IBND,IBDT,IBX,IBCHG,IBSEQNO,IBNOS,IBCNT,XMTEXT,XMSUB,XMZ,XMY,XMDUZ

CHG	; Pass a single charge to Accounts Receivable.

	S IBND=$G(^IB(IBREF,0)) I 'IBND K ^IB("AC",20,IBREF) G CHGQ

	S IBDT=DT,IBX="O" D TYPE^IBAUTL2

	I $$OLDRATE^IBAMTS1(IBRTED,$P(IBND,"^",14)) G CHGQ ; rate still old

	S $P(^IB(IBREF,0),"^",7)=IBCHG,IBSEQNO=1,DFN=+$P(IBND,"^",2)

	S IBNOS=IBREF D ^IBR S:Y>0 IBCNT=IBCNT+1

CHGQ	Q

IBEMTO    ;ALB/CPM - BILL MT CHARGES AWAITING NEW COPAY RATE ; 02-AUG-93

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

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

 +3       ;

 +4       ; Bill MT OPT charges on hold awaiting the new copay rate.

 +5       ;

ENO       ; Standalone option entry point

 +1        SET IBOPT=1

 +2       ;

ENR       ; Enter/edit billing rates entry point

 +1       ;

 +2       ; - quit if job has been fired up from enter/edit rates already

 +3        IF $GET(IBRUN)

               GOTO ENQ

 +4       ;

 +5       ; - quit if there are no charges on hold awaiting the new rate

 +6        IF '$DATA(^IB("AC",20))

               IF $GET(IBOPT)

                   WRITE !!,"There are no charges on hold awaiting the entry of the new copay rate."

               GOTO ENQ

 +7       ;

 +8       ; - quit if current rate is still too old

 +9        SET IBDT=DT

           SET IBX="O"

           DO TYPE^IBAUTL2

 +10       IF $$OLDRATE^IBAMTS1(IBRTED,DT)

               IF $GET(IBOPT)

                   Begin DoDot:1

 +11                   WRITE !!,"The current copay rate (effective ",$$DAT1^IBOUTL(IBRTED),") is still too old to use.  Please be"

 +12                   WRITE !,"sure that you have entered the most current rate in your Billing Rates table."

                   End DoDot:1

               GOTO ENQ

 +13      ;

 +14      ; - if x-ref is locked, the job must be currently running

 +15       LOCK +^IB("AC",20):5

          IF '$TEST

               IF $GET(IBOPT)

                   Begin DoDot:1

 +16                   WRITE !!,"The list of held charges cannot be accessed -- the job to bill these held"

 +17                   WRITE !,"charges may currently be running."

                   End DoDot:1

               GOTO ENQ

 +18      ;

 +19      ; - queue the job to bill the held charges?

 +20       IF '$GET(IBOPT)

               Begin DoDot:1

 +21               WRITE !!?28,*7,*7,"***  PLEASE NOTE  ***"

 +22               WRITE !?8,"The Means Test Outpatient Copayment rate has just been updated,"

 +23               WRITE !?8,"and there are charges 'on hold' awaiting the entry of this new rate!",!

               End DoDot:1

 +24      ;

 +25       IF $GET(IBOPT)

               Begin DoDot:1

 +26               SET IBN=0

                   FOR IBJ=0:1:21

                       SET IBN=$ORDER(^IB("AC",20,IBN))

                       IF 'IBN

                           QUIT

 +27               WRITE !!,"There ",$SELECT(IBJ=1:"is 1",1:"are "_$SELECT(IBJ>20:"at least ",1:"")_IBJ)," charge",$EXTRACT("s",IBJ>1)," on hold, awaiting the new copay rate."

               End DoDot:1

 +28       SET DIR(0)="Y"

           SET DIR("A")="Do you want to queue a job to automatically bill these held charges"

           SET DIR("?")="^D HQ^IBEMTO"

 +29       DO ^DIR

           KILL DIR

           IF 'Y!($DATA(DIRUT))!($DATA(DUOUT))

               GOTO ENQ

 +30      ;

 +31      ; - queue up job to bill held charges

 +32       IF '$GET(IBOPT)

               SET ZTDTH=$HOROLOG

 +33       SET ZTRTN="DQ^IBEMTO"

           SET ZTIO=""

           SET ZTDESC="BILLING OF MT OPT CHARGES AWAITING NEW COPAY RATE"

 +34       SET IBRUN=1

           DO ^%ZTLOAD

           WRITE !!,$SELECT($DATA(ZTSK):"This job has been queued.  The task number is "_ZTSK_".",1:"Unable to queue this job!")

 +35      ;

ENQ        LOCK -^IB("AC",20)

 +1        IF $GET(IBOPT)

               KILL IBRUN

 +2        KILL IBN,IBDT,IBATYP,IBDESC,IBJ,IBOPT,IBRTED,IBCHG,IBX,ZTSK

 +3        QUIT

 +4       ;

HQ        ; Help for prompt

 +1        WRITE !!,"If you wish to queue off a job to bill the Means Test Outpatient"

 +2        WRITE !,"copayment charges that are on hold awaiting entry of the updated"

 +3        WRITE !,"billing rate, please enter 'Y' or 'YES'.  The job will be tasked"

 +4        WRITE !,"immediately.  Otherwise, enter 'N' or 'NO' or '^' to quit."

 +5        QUIT

 +6       ;

 +7       ;

DQ        ; Tasked job to bill all charges awaiting the new copay rate.

 +1        SET IBJOB=8

           SET IBDUZ=DUZ

           SET IBSEQNO=1

           SET IBCNT=0

 +2       ;

 +3       ; - record start time

 +4        DO NOW^%DTC

           SET IBSTART=$$DAT2^IBOUTL(%)

 +5       ;

 +6       ; - if can't lock x-ref, job must currently be running

 +7        LOCK +^IB("AC",20):5

 +8       ;

 +9       ; - loop through all charges awaiting the new rate

 +10      IF $TEST

               SET IBREF=0

FOR

                   SET IBREF=$ORDER(^IB("AC",20,IBREF))

                   IF 'IBREF

                       QUIT

                   DO CHG

 +11      ;

 +12      ; - unlock x-ref, record end time, and post bulletin

 +13       LOCK -^IB("AC",20)

 +14       DO NOW^%DTC

           SET IBEND=$$DAT2^IBOUTL(%)

 +15       DO BULL^IBEMTO1

 +16       KILL IBT,IBSTART,IBEND,IBREF,IBND,IBDT,IBX,IBCHG,IBSEQNO,IBNOS,IBCNT,XMTEXT,XMSUB,XMZ,XMY,XMDUZ

 +17       QUIT

 +18      ;

CHG       ; Pass a single charge to Accounts Receivable.

 +1        SET IBND=$GET(^IB(IBREF,0))

           IF 'IBND

               KILL ^IB("AC",20,IBREF)

               GOTO CHGQ

 +2        SET IBDT=DT

           SET IBX="O"

           DO TYPE^IBAUTL2

 +3       ; rate still old

           IF $$OLDRATE^IBAMTS1(IBRTED,$PIECE(IBND,"^",14))

               GOTO CHGQ

 +4        SET $PIECE(^IB(IBREF,0),"^",7)=IBCHG

           SET IBSEQNO=1

           SET DFN=+$PIECE(IBND,"^",2)

 +5        SET IBNOS=IBREF

           DO ^IBR

           IF Y>0

               SET IBCNT=IBCNT+1

CHGQ       QUIT

IBEMTO.m