- 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
