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

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

initial load of FOIAVistA 6/30/08 version

File size: 3.8 KB
Line 
1IBARXEC1 ;ALB/AAS - RX CO-PAY EXEMPTION REPORT GENERATOR ; 04-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% ;
6START ; -- entry point for running conversion report from option
7 D HOME^%ZIS W @IOF,?15,"Medication Copayment Charges Retroactively Canceled",!!
8 ;
9 I '$P(^IBE(350.9,1,3),"^",14) W !!,"This report cannot be run until the conversion has completed." G END
10 ;
11BDT ; -get beginning date
12 S (IBBDT,IBEDT)=""
13 S Y=$$STDATE^IBARXEU D D^DIQ S %DT("B")=Y
14 S %DT="AEPX",%DT("A")="Start with DATE: " D ^%DT K %DT G END:Y<0 S IBBDT=Y
15 K %DT W !
16 ;
17EDT ; -get ending date
18 S Y=$P($P(^IBE(350.9,1,3),"^",14),".") D D^DIQ S %DT("B")=Y
19 S %DT="APEX",%DT("A")="Go to DATE: " D ^%DT G END:Y<0 S IBEDT=Y I Y<IBBDT W *7," ??",!,"ENDING DATE must follow BEGINNING DATE." G BDT
20 K %DT W !
21 ;
22 S DIR("A")="Print Conversion Quick Status Report with listing",DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR G:$D(DIRUT) END S IBQUIC=Y
23 ;
24DEV W !!,"You will need a 132 column printer for this report!",!
25 S %ZIS="QM" D ^%ZIS G:POP END
26 I $D(IO("Q")) S ZTRTN="REPORT^IBARXEC1",ZTSAVE("IB*")="",ZTDESC="IB Medication Copayment Exemption Conversion Report" D ^%ZTLOAD K ZTSK D HOME^%ZIS G END
27 ;
28REPORT ; -- run report for conversion
29 I $D(IBCONVER) D
30 .D QUIC
31 .Q:IO'=IO(0)
32 .I '$D(ZTQUEUED) W !!,"Please wait while I compile the report by patient...."
33 .W !!,"This report can be re-run by re-running the conversion",!,"or using the option provided."
34 .S IBBDT=$$STDATE^IBARXEU
35 .S IBEDT=$P(^IBE(350.9,1,3),"^",14)
36 .Q
37 ;
38 U IO
39 Q:'$P(^IBE(350.9,1,3),"^",14)
40 ;
41 S IBQUIT=0
42 I $G(IBQUIC)=1 D QUIC
43 D BUILD^IBARXEC4
44 D PRINT^IBARXEC5
45 ;
46END K ^TMP("IBCONV",$J)
47 I $D(ZTQUEUED) S ZTREQ="@" Q
48 K N,N1,O,O1,X,X1,X2,Y,DFN,IBAMT,IBBCNT,IBBDT,IBDT,IBEDT,IBJ,IBN,IBNAM,IBOK,IBP,IBPAG,IBCNT,IBPDAT,IBPCNT,IBQUIC,IBTAMT,IBTCNT,IBX
49 D END^IBARXEC
50 Q
51 ;
52QUIC ; -- quick summary
53 I '$D(IOF) D HOME^%ZIS
54 N IBX,X,X1,X2,X3,Y
55 S IBX=$G(^IBE(350.9,1,3)),X3=10
56 ;
57 W @IOF,?20,"Medication Copayment Exemption Conversion Status"
58 I '$P(IBX,"^",3),'$P(IBX,"^",13) W !!,"Conversion has not been started" Q
59 I $P(IBX,"^",3)>1 W !!,"The conversion has been started ",$P(IBX,"^",3)," times"
60 I $P(IBX,"^",13) W !!,"Conversion was started on: " S Y=$P(IBX,"^",13) D DT^DIQ
61 I $P(IBX,"^",14) W !,"The conversion completed on: " S Y=$P(IBX,"^",14) D DT^DIQ,ELAP W !,Y
62 W !!," Last Patient DFN Checked == ",$J(+$P(IBX,"^",4),10)
63 W !!," 1. Total Patients Checked == " S X=+$P(IBX,"^",5),X2=0 D COMMA^%DTC W X
64 W !," Exempt Patients == " S X=+$P(IBX,"^",6),X2=0 D COMMA^%DTC W X
65 W !," Non-Exempt Patients == " S X=+$P(IBX,"^",7),X2=0 D COMMA^%DTC W X
66 W !!," 2. Total Number of Rx Charges checked == " S X=+$P(IBX,"^",16),X2=0 D COMMA^%DTC W X
67 W !," Dollar Amount Checked == " S X=+$P(IBX,"^",9),X2="0$" D COMMA^%DTC W X
68 W !," No. of Exempt Rx Charges Checked == " S X=+$P(IBX,"^",8),X2=0 D COMMA^%DTC W X
69 W !," Exempt Dollar amount == " S X=+$P(IBX,"^",10),X2="0$" D COMMA^%DTC W X
70 W !," No. of Non-Exempt Rx Charges Checked == " S X=+$P(IBX,"^",15),X2=0 D COMMA^%DTC W X
71 W !," Non-exempt Dollar amount == " S X=+$P(IBX,"^",11),X2="0$" D COMMA^%DTC W X
72 W !!," 3. Total Rx Charges Actually canceled == " S X=+$P(IBX,"^",17),X2=0 D COMMA^%DTC W X
73 W !," Amount Actually canceled == " S X=+$P(IBX,"^",12),X2="0$" D COMMA^%DTC W X
74QUICQ Q
75 ;
76ELAP ; -- calcualate elaplse running time
77 N X,IBBDT,IBEDT,IBDAY
78 S X=$P(IBX,"^",13) D H^%DTC S IBBDT=%H_","_%T
79 S X=$P(IBX,"^",14) D H^%DTC S IBEDT=%H_","_%T
80 S IBDAY=+IBEDT-(+IBBDT)*86400 S X=IBDAY+$P(IBEDT,",",2)-$P(IBBDT,",",2) S Y="Elapsed time for Conversion was: "_(X\3600)_" Hours, "_(X\60-(X\3600*60))_" Minutes, "_(X#60)_" Seconds"
81 Q
Note: See TracBrowser for help on using the repository browser.