source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBARXEC5.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 2.3 KB
Line 
1IBARXEC5 ;ALB/AAS - RX COPAY EXEMPTION CONVERSION REPORT PRINT ; 14-JAN-93
2 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5% ;
6PRINT ; -- Print report
7 S IBPAG=0,IBQUIT=0 D NOW^%DTC S Y=% D D^DIQ S IBPDAT=Y
8 K IBBCNT
9 D HDR
10 I '$D(^TMP("IBCONV",$J)) W !,"No Charges Canceled due to Income Exemption in date range." Q
11 S IBNAM="",(IBPCNT,IBTAMT,IBTCNT)=0
12 F S IBNAM=$O(^TMP("IBCONV",$J,IBNAM)) Q:IBNAM=""!(IBQUIT) D
13 .S DFN=0 F S DFN=$O(^TMP("IBCONV",$J,IBNAM,DFN)) Q:'DFN!(IBQUIT) S IBPCNT=IBPCNT+1 D
14 ..S (IBBCNT,IBAMT,IBN)=0 F S IBN=$O(^TMP("IBCONV",$J,IBNAM,DFN,IBN)) D:IBN="" SUB Q:'IBN!(IBQUIT) S X2=^(IBN) D ONE
15 ;
16 D:'IBQUIT SUM
17 K ^TMP("IBCONV",$J)
18 Q
19 ;
20ONE ; -- print one line
21 I ($Y+5)>IOSL D PAUSE^IBOUTL,HDR:'IBQUIT
22 W ! I 'IBBCNT W $E(IBNAM,1,20),?22,$P(X2,"^",2) S ERR="" D ERR I ERR]"" W ?36,ERR,!
23 ;
24 S N=$G(^IB(IBN,0)),N1=$G(^(1)) ; new copay nodes
25 S O=$G(^IB(+$P(N,"^",9),0)),O1=$G(^(1)) ; original copay nodes
26 S IBBCNT=IBBCNT+1,IBAMT=IBAMT+$P(N,"^",7),IBTAMT=IBTAMT+$P(N,"^",7),IBTCNT=IBTCNT+1
27 ;
28 W ?36,$$DAT1^IBOUTL($P(O1,"^",2))
29 ;
30 S Y=+$P($P($P(O,"^",4),";",2),":",2)
31 W $J($P($P(O,"^",8),"-"),9),$S(+Y:"/"_Y,1:"")
32 W ?57,$$DAT1^IBOUTL($P(N1,"^",2)),?68,+N,?81,$P(N,"^",11),?97,"$",$P(N,"^",7)
33 Q
34 ;
35HDR ; -- print header
36 I $D(IBCONVER)!($G(IBQUIC))!(IBPAG)!($E(IOST,1,2)="C-") W @IOF
37 S IBPAG=IBPAG+1
38 W "Rx Copay Income Exemption Report",?(IOM-35)
39 W $P(IBPDAT,"@")," ",$P(IBPDAT,"@",2)," Page ",IBPAG
40 W !,"Charges Canceled ",$S(IBBDT=IBEDT:"on "_$$DAT1^IBOUTL(IBBDT),1:"from "_$$DAT1^IBOUTL(IBBDT)_" to "_$$DAT1^IBOUTL(IBEDT))
41 W !," Cancel Cancel Original"
42 W !,"Name Pt. ID Rx Date Rx/Refill Date IB Number Bill No. Amount"
43 W !,$TR($J(" ",IOM)," ","-")
44 Q
45 ;
46SUB ; -- write sub totals
47 W !,?85,"--------------"
48 W !,?85,"Count = ",$J(IBBCNT,4)
49 W !,?85,"Amount = $",$J(IBAMT,4),!
50 Q
51 ;
52SUM ; -- print final summary
53 W !!?40,"======================================="
54 W !?40," Total Patient Count = ",$J(IBPCNT,7)
55 W !?40," Total Rx Count = ",$J(IBTCNT,7)
56 W !?40," Total Dollar amount = $",$J(IBTAMT,7)
57 Q
58 ;
59ERR ; -- see if any errors
60 N DJ S DJ=""
61 F S DJ=$O(^TMP("IB-ERROR",DJ)) Q:DJ="" S ERR=$G(^TMP("IB-ERROR",DJ,DFN)) Q:ERR]""
62 Q
Note: See TracBrowser for help on using the repository browser.