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)
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 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()
Q
;
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
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBEMTO1 3141 printed Dec 13, 2024@02:22:09 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
