| 1 | IBARXEC ;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 | ;
|
|---|
| 7 | EN ; -- Entry Point to run conversion from start date of exemption to
|
|---|
| 8 | ; today
|
|---|
| 9 | ;
|
|---|
| 10 | USER 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 | ;
|
|---|
| 26 | REFUND ; -- 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 | ;
|
|---|
| 52 | DEV 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 | ;
|
|---|
| 58 | END 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
|
|---|
