source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBARXEC.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.8 KB
Line 
1IBARXEC ;ALB/AAS -RX CO-PAY INCOME EXEMPTION CONVERSION ; 2-NOV-92
2 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5% Q:'$D(^IBE(350.9,1,0))
6 ;
7EN ; -- Entry Point to run conversion from start date of exemption to
8 ; today
9 ;
10USER I $S('($D(DUZ)#2):1,'$D(^VA(200,+DUZ,0)):1,'$D(DUZ(0)):1,DUZ(0)'="@":1,1:0) W !!?3,"The variable DUZ must be set to an active user code and the variable",!?3,"DUZ(0) must equal '@' to run the conversion.",! G END
11 ;
12 S IBDT=$$STDATE^IBARXEU,IBEDT=DT
13 S IBCONVER=1,IBQUIT=0
14 ;
15 ; -- make sure variable set
16 D DT^DICRW,HOME^%ZIS W @IOF,?15,"IB Medication Copayment Exemption Conversion",!!!
17 I $P($G(^IBE(350.9,1,3)),"^",3)="" D HELP^IBARXEC0
18 G:IBQUIT END
19 ;
20 ; -- make sure environment is set
21 I '$D(^IBA(354,0)) W !,"You must first install patch IB*1.5*9!" G END
22 S X="PRCAX" X ^%ZOSF("TEST") I '$T W !,"You must first install patch PRCA*3.7*8!" G END
23 S X="DGMTCOU1" X ^%ZOSF("TEST") I '$T W !,"You must first install MAS patch DG*5.2*??!" G END
24 I $D(^DGMT(408.31,"AID",1))'=10 W !,"You must re-run the Post-Init to the DGYGINIT routines, missing cross-referece" G END
25 ;
26REFUND ; -- make sure AR set up for refunds
27 D I IBQUIT G END
28 .I '$D(^DIC(49,"D","04")) S IBQUIT=1
29 .I '$D(^DIC(49,"B","FISCAL")) S IBQUIT=1
30 .I IBQUIT W !,"In order to do refunds a service of 'FISCAL' with a mail symbol of 04 must ",!,"be defined",!
31 .Q
32 ;
33 ; -- make sure not already done
34 K IBDONE
35 S Y=$P($G(^IBE(350.9,1,3)),"^",14) I Y S IBDONE=1 W !!,"Conversion already finished on " D DT^DIQ W !!,"Reprinting the Report...",! G DEV
36 ;
37 ; -- check if running alread running
38 I $D(IBCONVER) S IBARXJOB=+$P($G(^IBE(350.9,1,3)),"^",3) D
39 .;
40 .S IBARXJOB=IBARXJOB+1
41 .I IBARXJOB=1 D NOW^%DTC S $P(^IBE(350.9,1,3),"^",13)=% Q ; -- first time to run conversion
42 .;
43 .W !,*7,"WARNING: Conversion May Already be Running!",!,"Check your system status if you are unsure.",!!
44 .D RESTART^IBARXEC0
45 .S DIR(0)="Y",DIR("A")="Are You Sure you Want to Restart",DIR("B")="NO"
46 .D ^DIR K DIR I 'Y!($D(DIRUT)) K IBARXJOB Q
47 .Q
48 ;
49 I '$D(IBARXJOB) G END
50 S $P(^IBE(350.9,1,3),"^",3)=IBARXJOB
51 ;
52DEV W !!,"You will need a 132 column printer for this report!",!
53 S %ZIS="QM" D ^%ZIS G:POP END
54 I $D(IO("Q")) S ZTRTN="DQ^IBARXEC3",ZTSAVE("IB*")="",ZTDESC="IB Medication Copayment Exemption Conversion" D ^%ZTLOAD D HOME^%ZIS G END
55 ;
56 G DQ^IBARXEC3
57 ;
58END K ^TMP("IBCONV",$J)
59 I $D(ZTQUEUED) S ZTREQ="@" Q
60 K DIC,DIE,DA,DR,D0,DGT,DIR,DIRUT,ERR,I,J,LINE,XMZ
61 K IBAFY,IBARXJOB,IBCANDT,IBCBCNT,IBCEAMT,IBCECNT,IBCONVER,IBDONE,IBEAMT,IBECNT,IBEFAC,IBL,IBLAST,IBLDT,IBNAMT,IBNCNT,IBND,IBNECNT,IBNOW,IBPARDT,IBPARNT,IBPARNT1,IBQUIT,IBJOB,IBWHER,IBEXERR
62 K IBDT,IBEDT,IBJ,IBSITE,IBSTAT,IBTBCNT,IBTCBCNT,IBTCEAMT,IBTCECNT,IBTEAMT,IBTECNT,IBTNAMT,IBTNCNT,IBTNECNT,IBADD,IBADDE,IBDATA,IBDEPEN,IBERR,IBEXREA,IBFAC
63 D ^%ZISC
64 Q
Note: See TracBrowser for help on using the repository browser.