Routine: IBEMTO1

IBEMTO1 ;ALB/CPM-LIST MT CHARGES AWAITING NEW COPAY RATE;10-AUG-93

 ;;2.0;INTEGRATED BILLING;**183**;21-MAR-94

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

EN ; List Means Test charges on hold, awaiting the new copay rate.

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

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

 ; - select a device

 S %ZIS="QM" D ^%ZIS G:POP ENQ

 I $D(IO("Q")) D  G ENQ

 .S ZTRTN="DQ^IBEMTO1",ZTDESC="LIST MT CHARGES ON HOLD AWAITING NEW COPAY RATE"

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

 .K ZTSK,IO("Q") D HOME^%ZIS

 U IO

DQ ; Tasked entry point.

 ; - compile data

 D ENQ1 S IBN=0 F  S IBN=$O(^IB("AC",20,IBN)) Q:'IBN  D

 .S IBND=$G(^IB(IBN,0)),DFN=+$P(IBND,"^",2) Q:'DFN

 .S IBPT=$$PT^IBEFUNC(DFN)

 .S ^TMP("IBEMTO1",$J,$P(IBPT,"^")_"@"_$P(IBPT,"^",3)_"@"_DFN,IBN)=""

 S (IBPAG,IBQ)=0 D HDR

 ; - print message if there are no charges

 I '$D(^TMP("IBEMTO1",$J)) W !!,"There are no charges on hold awaiting the new copay rate." D PAUSE^IBEMTF2 G ENQ

 ; - print charges

 S IBNAM="" F  S IBNAM=$O(^TMP("IBEMTO1",$J,IBNAM)) Q:IBNAM=""  D  Q:IBQ

 .I $Y>(IOSL-3) D PAUSE^IBEMTF2 Q:IBQ  D HDR

 .W !,$P(IBNAM,"@"),"  (",$P(IBNAM,"@",2),")"

 .S (IBF,IBN)=0 F  S IBN=$O(^TMP("IBEMTO1",$J,IBNAM,IBN)) Q:'IBN  D  Q:IBQ

 ..I IBF,$Y>(IOSL-3) D PAUSE^IBEMTF2 Q:IBQ  D HDR

 ..S IBND=$G(^IB(IBN,0))

 ..W:IBF ! W ?41,$$DAT1^IBOUTL($P(IBND,"^",14)),?61,$$FORMAT(+$P(IBND,"^",7),10)

 ..S IBF=1

 ; - end-of-report pause

 D:'IBQ PAUSE^IBEMTF2

ENQ I '$D(ZTQUEUED) D ^%ZISC

 K DFN,IBF,IBN,IBNAM,IBND,IBPT,IBQ,IBPAG

ENQ1 K ^TMP("IBEMTO1",$J)

HDR ; Generate a report header.

 I $E(IOST,1,2)="C-"!(IBPAG) W @IOF,*13

 S IBPAG=IBPAG+1

 W ?14,"LIST OF ALL COPAYMENT/PER DIEM CHARGES 'ON HOLD'"

 W !?18,"AWAITING ENTRY OF THE NEW RATE",?64,"Page: ",IBPAG

 W !?60,"Run Date: ",$$DAT1^IBOUTL(DT)

 W !,$$DASH(),!,"PATIENT NAME (ID)",?41,"BILL FROM",?64,"CHARGE",!,$$DASH()

DASH() ; Return a dashed line.

 Q $TR($J("",80)," ","-")

 ; Number format

FORMAT(IBNUM,IBDIG,IBFRM) ;

 N X,X1,X2,X3

 S X=IBNUM,X2=$G(IBFRM,"2$"),X3=IBDIG

 D COMMA^%DTC

Q X

BULL ; Post results of background billing run in a bulletin.

 K IBT

 S XMTEXT="IBT("

 S XMSUB="BILLING OF MEANS TEST CHARGES AWAITING NEW COPAY RATE"

 S XMDUZ="INTEGRATED BILLING PACKAGE"

 S IBT(1)="The job to automatically bill Means Test Outpatient copayment charges"

 S IBT(2)="which were on hold, awaiting the new copayment rate, has just completed."

 S IBT(3)=" "

 S IBT(4)="          Job Start Time: "_$P(IBSTART,"@")_" at "_$P(IBSTART,"@",2)

 S IBT(5)="            Job End Time: "_$P(IBEND,"@")_" at "_$P(IBEND,"@",2)

 S IBT(6)=" "

 S IBT(7)="Number of charges billed: "_IBCNT

 S IBT(8)=$S($D(^IB("AC",20)):"Please Note!  There are still similar charges which remain on hold.",1:"There are no longer any charges awaiting the new copay rate which are on hold.")

 S XMY(DUZ)=""

 D ^XMD

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBEMTO1   3141     printed  Mar 13, 2025@21:27:07                                                                                                                                                                                                     Page 2

IBEMTO1   ;ALB/CPM-LIST MT CHARGES AWAITING NEW COPAY RATE;10-AUG-93

 +1       ;;2.0;INTEGRATED BILLING;**183**;21-MAR-94

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

 +3       ;

EN        ; List Means Test charges on hold, awaiting the new copay rate.

 +1       ;

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

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

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

               GOTO ENQ

 +4       ;

 +5       ; - select a device

 +6        SET %ZIS="QM"

           DO ^%ZIS

           if POP

               GOTO ENQ

 +7        IF $DATA(IO("Q"))

               Begin DoDot:1

 +8                SET ZTRTN="DQ^IBEMTO1"

                   SET ZTDESC="LIST MT CHARGES ON HOLD AWAITING NEW COPAY RATE"

 +9                DO ^%ZTLOAD

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

 +10               KILL ZTSK,IO("Q")

                   DO HOME^%ZIS

               End DoDot:1

               GOTO ENQ

 +11      ;

 +12       USE IO

 +13      ;

DQ        ; Tasked entry point.

 +1       ;

 +2       ; - compile data

 +3        DO ENQ1

           SET IBN=0

FOR

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

               if 'IBN

                   QUIT

               Begin DoDot:1

 +4                SET IBND=$GET(^IB(IBN,0))

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

                   if 'DFN

                       QUIT

 +5                SET IBPT=$$PT^IBEFUNC(DFN)

 +6                SET ^TMP("IBEMTO1",$JOB,$PIECE(IBPT,"^")_"@"_$PIECE(IBPT,"^",3)_"@"_DFN,IBN)=""

               End DoDot:1

 +7       ;

 +8        SET (IBPAG,IBQ)=0

           DO HDR

 +9       ; - print message if there are no charges

 +10       IF '$DATA(^TMP("IBEMTO1",$JOB))

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

               DO PAUSE^IBEMTF2

               GOTO ENQ

 +11      ;

 +12      ; - print charges

 +13       SET IBNAM=""

FOR

               SET IBNAM=$ORDER(^TMP("IBEMTO1",$JOB,IBNAM))

               if IBNAM=""

                   QUIT

               Begin DoDot:1

 +14               IF $Y>(IOSL-3)

                       DO PAUSE^IBEMTF2

                       if IBQ

                           QUIT

                       DO HDR

 +15               WRITE !,$PIECE(IBNAM,"@"),"  (",$PIECE(IBNAM,"@",2),")"

 +16               SET (IBF,IBN)=0

FOR

                       SET IBN=$ORDER(^TMP("IBEMTO1",$JOB,IBNAM,IBN))

                       if 'IBN

                           QUIT

                       Begin DoDot:2

 +17                       IF IBF

                               IF $Y>(IOSL-3)

                                   DO PAUSE^IBEMTF2

                                   if IBQ

                                       QUIT

                                   DO HDR

 +18                       SET IBND=$GET(^IB(IBN,0))

 +19                       if IBF

                               WRITE !

                           WRITE ?41,$$DAT1^IBOUTL($PIECE(IBND,"^",14)),?61,$$FORMAT(+$PIECE(IBND,"^",7),10)

 +20                       SET IBF=1

                       End DoDot:2

                       if IBQ

                           QUIT

               End DoDot:1

               if IBQ

                   QUIT

 +21      ;

 +22      ; - end-of-report pause

 +23       if 'IBQ

               DO PAUSE^IBEMTF2

 +24      ;

ENQ        IF '$DATA(ZTQUEUED)

               DO ^%ZISC

 +1        KILL DFN,IBF,IBN,IBNAM,IBND,IBPT,IBQ,IBPAG

ENQ1       KILL ^TMP("IBEMTO1",$JOB)

 +1        QUIT

 +2       ;

HDR       ; Generate a report header.

 +1        IF $EXTRACT(IOST,1,2)="C-"!(IBPAG)

               WRITE @IOF,*13

 +2        SET IBPAG=IBPAG+1

 +3        WRITE ?14,"LIST OF ALL COPAYMENT/PER DIEM CHARGES 'ON HOLD'"

 +4        WRITE !?18,"AWAITING ENTRY OF THE NEW RATE",?64,"Page: ",IBPAG

 +5        WRITE !?60,"Run Date: ",$$DAT1^IBOUTL(DT)

 +6        WRITE !,$$DASH(),!,"PATIENT NAME (ID)",?41,"BILL FROM",?64,"CHARGE",!,$$DASH()

 +7        QUIT

 +8       ;

DASH()    ; Return a dashed line.

 +1        QUIT $TRANSLATE($JUSTIFY("",80)," ","-")

 +2       ;

 +3       ; Number format

FORMAT(IBNUM,IBDIG,IBFRM) ;

 +1        NEW X,X1,X2,X3

 +2        SET X=IBNUM

           SET X2=$GET(IBFRM,"2$")

           SET X3=IBDIG

 +3        DO COMMA^%DTC

 +4        QUIT X

 +5       ;

BULL      ; Post results of background billing run in a bulletin.

 +1        KILL IBT

 +2        SET XMTEXT="IBT("

 +3        SET XMSUB="BILLING OF MEANS TEST CHARGES AWAITING NEW COPAY RATE"

 +4        SET XMDUZ="INTEGRATED BILLING PACKAGE"

 +5        SET IBT(1)="The job to automatically bill Means Test Outpatient copayment charges"

 +6        SET IBT(2)="which were on hold, awaiting the new copayment rate, has just completed."

 +7        SET IBT(3)=" "

 +8        SET IBT(4)="          Job Start Time: "_$PIECE(IBSTART,"@")_" at "_$PIECE(IBSTART,"@",2)

 +9        SET IBT(5)="            Job End Time: "_$PIECE(IBEND,"@")_" at "_$PIECE(IBEND,"@",2)

 +10       SET IBT(6)=" "

 +11       SET IBT(7)="Number of charges billed: "_IBCNT

 +12       SET IBT(8)=$SELECT($DATA(^IB("AC",20)):"Please Note!  There are still similar charges which remain on hold.",1:"There are no longer any charges awaiting the new copay rate which are on hold.")

 +13       SET XMY(DUZ)=""

 +14       DO ^XMD

 +15       QUIT

IBEMTO1.m