source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBEMTO1.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1IBEMTO1 ;ALB/CPM-LIST MT CHARGES AWAITING NEW COPAY RATE;10-AUG-93
2 ;;2.0;INTEGRATED BILLING;**183**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EN ; List Means Test charges on hold, awaiting the new copay rate.
6 ;
7 ; - quit if there are no charges on hold awaiting the new rate
8 I '$D(^IB("AC",20)) W !!,"There are no charges on hold awaiting the entry of the new copay rate." G ENQ
9 ;
10 ; - select a device
11 S %ZIS="QM" D ^%ZIS G:POP ENQ
12 I $D(IO("Q")) D G ENQ
13 .S ZTRTN="DQ^IBEMTO1",ZTDESC="LIST MT CHARGES ON HOLD AWAITING NEW COPAY RATE"
14 .D ^%ZTLOAD W !!,$S($D(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
15 .K ZTSK,IO("Q") D HOME^%ZIS
16 ;
17 U IO
18 ;
19DQ ; Tasked entry point.
20 ;
21 ; - compile data
22 D ENQ1 S IBN=0 F S IBN=$O(^IB("AC",20,IBN)) Q:'IBN D
23 .S IBND=$G(^IB(IBN,0)),DFN=+$P(IBND,"^",2) Q:'DFN
24 .S IBPT=$$PT^IBEFUNC(DFN)
25 .S ^TMP("IBEMTO1",$J,$P(IBPT,"^")_"@"_$P(IBPT,"^",3)_"@"_DFN,IBN)=""
26 ;
27 S (IBPAG,IBQ)=0 D HDR
28 ; - print message if there are no charges
29 I '$D(^TMP("IBEMTO1",$J)) W !!,"There are no charges on hold awaiting the new copay rate." D PAUSE^IBEMTF2 G ENQ
30 ;
31 ; - print charges
32 S IBNAM="" F S IBNAM=$O(^TMP("IBEMTO1",$J,IBNAM)) Q:IBNAM="" D Q:IBQ
33 .I $Y>(IOSL-3) D PAUSE^IBEMTF2 Q:IBQ D HDR
34 .W !,$P(IBNAM,"@")," (",$P(IBNAM,"@",2),")"
35 .S (IBF,IBN)=0 F S IBN=$O(^TMP("IBEMTO1",$J,IBNAM,IBN)) Q:'IBN D Q:IBQ
36 ..I IBF,$Y>(IOSL-3) D PAUSE^IBEMTF2 Q:IBQ D HDR
37 ..S IBND=$G(^IB(IBN,0))
38 ..W:IBF ! W ?41,$$DAT1^IBOUTL($P(IBND,"^",14)),?61,$$FORMAT(+$P(IBND,"^",7),10)
39 ..S IBF=1
40 ;
41 ; - end-of-report pause
42 D:'IBQ PAUSE^IBEMTF2
43 ;
44ENQ I '$D(ZTQUEUED) D ^%ZISC
45 K DFN,IBF,IBN,IBNAM,IBND,IBPT,IBQ,IBPAG
46ENQ1 K ^TMP("IBEMTO1",$J)
47 Q
48 ;
49HDR ; Generate a report header.
50 I $E(IOST,1,2)="C-"!(IBPAG) W @IOF,*13
51 S IBPAG=IBPAG+1
52 W ?14,"LIST OF ALL COPAYMENT/PER DIEM CHARGES 'ON HOLD'"
53 W !?18,"AWAITING ENTRY OF THE NEW RATE",?64,"Page: ",IBPAG
54 W !?60,"Run Date: ",$$DAT1^IBOUTL(DT)
55 W !,$$DASH(),!,"PATIENT NAME (ID)",?41,"BILL FROM",?64,"CHARGE",!,$$DASH()
56 Q
57 ;
58DASH() ; Return a dashed line.
59 Q $TR($J("",80)," ","-")
60 ;
61 ; Number format
62FORMAT(IBNUM,IBDIG,IBFRM) ;
63 N X,X1,X2,X3
64 S X=IBNUM,X2=$G(IBFRM,"2$"),X3=IBDIG
65 D COMMA^%DTC
66 Q X
67 ;
68BULL ; Post results of background billing run in a bulletin.
69 K IBT
70 S XMTEXT="IBT("
71 S XMSUB="BILLING OF MEANS TEST CHARGES AWAITING NEW COPAY RATE"
72 S XMDUZ="INTEGRATED BILLING PACKAGE"
73 S IBT(1)="The job to automatically bill Means Test Outpatient copayment charges"
74 S IBT(2)="which were on hold, awaiting the new copayment rate, has just completed."
75 S IBT(3)=" "
76 S IBT(4)=" Job Start Time: "_$P(IBSTART,"@")_" at "_$P(IBSTART,"@",2)
77 S IBT(5)=" Job End Time: "_$P(IBEND,"@")_" at "_$P(IBEND,"@",2)
78 S IBT(6)=" "
79 S IBT(7)="Number of charges billed: "_IBCNT
80 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.")
81 S XMY(DUZ)=""
82 D ^XMD
83 Q
Note: See TracBrowser for help on using the repository browser.