IBEMTO1 ;ALB/CPM - LIST MT CHARGES AWAITING NEW COPAY RATE ; 10-AUG-93
;;Version 2.0 ; INTEGRATED BILLING ;; 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)=""
;
; - print message if there are no charges
S (IBPAG,IBQ)=0 D HDR 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,"$",$P(IBND,"^",7)
..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)
Q
;
HDR ; Generate a report header.
I $E(IOST,1,2)="C-"!(IBPAG) W @IOF,*13
S IBPAG=IBPAG+1
W ?14,"LIST OF ALL OUTPATIENT COPAYMENT CHARGES 'ON HOLD'",!?18,"AWAITING ENTRY OF THE NEW COPAYMENT RATE"
W !?64,"Page: ",IBPAG,!?60,"Run Date: ",$$DAT1^IBOUTL(DT)
W !,$$DASH(),!,"Patient Name (ID)",?40,"Visit Date",?60,"Charge",!,$$DASH(),!
Q
;
DASH() ; Return a dashed line.
Q $TR($J("",80)," ","-")
;
;
;
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
Q
IBEMTO1 ;ALB/CPM - LIST MT CHARGES AWAITING NEW COPAY RATE ; 10-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 ;
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 ; - print message if there are no charges
+9 SET (IBPAG,IBQ)=0
DO HDR
IF '$DATA(^TMP("IBEMTO1",$JOB))
WRITE !,"There are no charges on hold awaiting the new copay rate."
DO PAUSE^IBEMTF2
GOTO ENQ
+10 ;
+11 ; - print charges
+12 SET IBNAM=""
FOR
SET IBNAM=$ORDER(^TMP("IBEMTO1",$JOB,IBNAM))
IF IBNAM=""
QUIT
Begin DoDot:1
+13 IF $Y>(IOSL-3)
DO PAUSE^IBEMTF2
IF IBQ
QUIT
DO HDR
+14 WRITE !,$PIECE(IBNAM,"@")," (",$PIECE(IBNAM,"@",2),")"
+15 SET (IBF,IBN)=0
FOR
SET IBN=$ORDER(^TMP("IBEMTO1",$JOB,IBNAM,IBN))
IF 'IBN
QUIT
Begin DoDot:2
+16 IF IBF
IF $Y>(IOSL-3)
DO PAUSE^IBEMTF2
IF IBQ
QUIT
DO HDR
+17 SET IBND=$GET(^IB(IBN,0))
+18 IF IBF
WRITE !
WRITE ?41,$$DAT1^IBOUTL($PIECE(IBND,"^",14)),?61,"$",$PIECE(IBND,"^",7)
+19 SET IBF=1
End DoDot:2
IF IBQ
QUIT
End DoDot:1
IF IBQ
QUIT
+20 ;
+21 ; - end-of-report pause
+22 IF 'IBQ
DO PAUSE^IBEMTF2
+23 ;
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 OUTPATIENT COPAYMENT CHARGES 'ON HOLD'",!?18,"AWAITING ENTRY OF THE NEW COPAYMENT RATE"
+4 WRITE !?64,"Page: ",IBPAG,!?60,"Run Date: ",$$DAT1^IBOUTL(DT)
+5 WRITE !,$$DASH(),!,"Patient Name (ID)",?40,"Visit Date",?60,"Charge",!,$$DASH(),!
+6 QUIT
+7 ;
DASH() ; Return a dashed line.
+1 QUIT $TRANSLATE($JUSTIFY("",80)," ","-")
+2 ;
+3 ;
+4 ;
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
