IBARXEC ;ALB/AAS -RX CO-PAY INCOME EXEMPTION CONVERSION ; 2-NOV-92
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
% Q:'$D(^IBE(350.9,1,0))
;
EN ; -- Entry Point to run conversion from start date of exemption to
; today
;
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
;
S IBDT=$$STDATE^IBARXEU,IBEDT=DT
S IBCONVER=1,IBQUIT=0
;
; -- make sure variable set
D DT^DICRW,HOME^%ZIS W @IOF,?15,"IB Medication Copayment Exemption Conversion",!!!
I $P($G(^IBE(350.9,1,3)),"^",3)="" D HELP^IBARXEC0
G:IBQUIT END
;
; -- make sure environment is set
I '$D(^IBA(354,0)) W !,"You must first install patch IB*1.5*9!" G END
S X="PRCAX" X ^%ZOSF("TEST") I '$T W !,"You must first install patch PRCA*3.7*8!" G END
S X="DGMTCOU1" X ^%ZOSF("TEST") I '$T W !,"You must first install MAS patch DG*5.2*??!" G END
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
;
REFUND ; -- make sure AR set up for refunds
D I IBQUIT G END
.I '$D(^DIC(49,"D","04")) S IBQUIT=1
.I '$D(^DIC(49,"B","FISCAL")) S IBQUIT=1
.I IBQUIT W !,"In order to do refunds a service of 'FISCAL' with a mail symbol of 04 must ",!,"be defined",!
.Q
;
; -- make sure not already done
K IBDONE
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
;
; -- check if running alread running
I $D(IBCONVER) S IBARXJOB=+$P($G(^IBE(350.9,1,3)),"^",3) D
.;
.S IBARXJOB=IBARXJOB+1
.I IBARXJOB=1 D NOW^%DTC S $P(^IBE(350.9,1,3),"^",13)=% Q ; -- first time to run conversion
.;
.W !,*7,"WARNING: Conversion May Already be Running!",!,"Check your system status if you are unsure.",!!
.D RESTART^IBARXEC0
.S DIR(0)="Y",DIR("A")="Are You Sure you Want to Restart",DIR("B")="NO"
.D ^DIR K DIR I 'Y!($D(DIRUT)) K IBARXJOB Q
.Q
;
I '$D(IBARXJOB) G END
S $P(^IBE(350.9,1,3),"^",3)=IBARXJOB
;
DEV W !!,"You will need a 132 column printer for this report!",!
S %ZIS="QM" D ^%ZIS G:POP END
I $D(IO("Q")) S ZTRTN="DQ^IBARXEC3",ZTSAVE("IB*")="",ZTDESC="IB Medication Copayment Exemption Conversion" D ^%ZTLOAD D HOME^%ZIS G END
;
G DQ^IBARXEC3
;
END K ^TMP("IBCONV",$J)
I $D(ZTQUEUED) S ZTREQ="@" Q
K DIC,DIE,DA,DR,D0,DGT,DIR,DIRUT,ERR,I,J,LINE,XMZ
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
K IBDT,IBEDT,IBJ,IBSITE,IBSTAT,IBTBCNT,IBTCBCNT,IBTCEAMT,IBTCECNT,IBTEAMT,IBTECNT,IBTNAMT,IBTNCNT,IBTNECNT,IBADD,IBADDE,IBDATA,IBDEPEN,IBERR,IBEXREA,IBFAC
D ^%ZISC
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBARXEC 2949 printed Nov 22, 2024@17:17:12 Page 2
IBARXEC ;ALB/AAS -RX CO-PAY INCOME EXEMPTION CONVERSION ; 2-NOV-92
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
% if '$DATA(^IBE(350.9,1,0))
QUIT
+1 ;
EN ; -- Entry Point to run conversion from start date of exemption to
+1 ; today
+2 ;
USER IF $SELECT('($DATA(DUZ)#2):1,'$DATA(^VA(200,+DUZ,0)):1,'$DATA(DUZ(0)):1,DUZ(0)'="@":1,1:0)
WRITE !!?3,"The variable DUZ must be set to an active user code and the variable",!?3,"DUZ(0) must equal '@' to run the conversion.",!
GOTO END
+1 ;
+2 SET IBDT=$$STDATE^IBARXEU
SET IBEDT=DT
+3 SET IBCONVER=1
SET IBQUIT=0
+4 ;
+5 ; -- make sure variable set
+6 DO DT^DICRW
DO HOME^%ZIS
WRITE @IOF,?15,"IB Medication Copayment Exemption Conversion",!!!
+7 IF $PIECE($GET(^IBE(350.9,1,3)),"^",3)=""
DO HELP^IBARXEC0
+8 if IBQUIT
GOTO END
+9 ;
+10 ; -- make sure environment is set
+11 IF '$DATA(^IBA(354,0))
WRITE !,"You must first install patch IB*1.5*9!"
GOTO END
+12 SET X="PRCAX"
XECUTE ^%ZOSF("TEST")
IF '$TEST
WRITE !,"You must first install patch PRCA*3.7*8!"
GOTO END
+13 SET X="DGMTCOU1"
XECUTE ^%ZOSF("TEST")
IF '$TEST
WRITE !,"You must first install MAS patch DG*5.2*??!"
GOTO END
+14 IF $DATA(^DGMT(408.31,"AID",1))'=10
WRITE !,"You must re-run the Post-Init to the DGYGINIT routines, missing cross-referece"
GOTO END
+15 ;
REFUND ; -- make sure AR set up for refunds
+1 Begin DoDot:1
+2 IF '$DATA(^DIC(49,"D","04"))
SET IBQUIT=1
+3 IF '$DATA(^DIC(49,"B","FISCAL"))
SET IBQUIT=1
+4 IF IBQUIT
WRITE !,"In order to do refunds a service of 'FISCAL' with a mail symbol of 04 must ",!,"be defined",!
+5 QUIT
End DoDot:1
IF IBQUIT
GOTO END
+6 ;
+7 ; -- make sure not already done
+8 KILL IBDONE
+9 SET Y=$PIECE($GET(^IBE(350.9,1,3)),"^",14)
IF Y
SET IBDONE=1
WRITE !!,"Conversion already finished on "
DO DT^DIQ
WRITE !!,"Reprinting the Report...",!
GOTO DEV
+10 ;
+11 ; -- check if running alread running
+12 IF $DATA(IBCONVER)
SET IBARXJOB=+$PIECE($GET(^IBE(350.9,1,3)),"^",3)
Begin DoDot:1
+13 ;
+14 SET IBARXJOB=IBARXJOB+1
+15 ; -- first time to run conversion
IF IBARXJOB=1
DO NOW^%DTC
SET $PIECE(^IBE(350.9,1,3),"^",13)=%
QUIT
+16 ;
+17 WRITE !,*7,"WARNING: Conversion May Already be Running!",!,"Check your system status if you are unsure.",!!
+18 DO RESTART^IBARXEC0
+19 SET DIR(0)="Y"
SET DIR("A")="Are You Sure you Want to Restart"
SET DIR("B")="NO"
+20 DO ^DIR
KILL DIR
IF 'Y!($DATA(DIRUT))
KILL IBARXJOB
QUIT
+21 QUIT
End DoDot:1
+22 ;
+23 IF '$DATA(IBARXJOB)
GOTO END
+24 SET $PIECE(^IBE(350.9,1,3),"^",3)=IBARXJOB
+25 ;
DEV WRITE !!,"You will need a 132 column printer for this report!",!
+1 SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO END
+2 IF $DATA(IO("Q"))
SET ZTRTN="DQ^IBARXEC3"
SET ZTSAVE("IB*")=""
SET ZTDESC="IB Medication Copayment Exemption Conversion"
DO ^%ZTLOAD
DO HOME^%ZIS
GOTO END
+3 ;
+4 GOTO DQ^IBARXEC3
+5 ;
END KILL ^TMP("IBCONV",$JOB)
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+2 KILL DIC,DIE,DA,DR,D0,DGT,DIR,DIRUT,ERR,I,J,LINE,XMZ
+3 KILL 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
+4 KILL IBDT,IBEDT,IBJ,IBSITE,IBSTAT,IBTBCNT,IBTCBCNT,IBTCEAMT,IBTCECNT,IBTEAMT,IBTECNT,IBTNAMT,IBTNCNT,IBTNECNT,IBADD,IBADDE,IBDATA,IBDEPEN,IBERR,IBEXREA,IBFAC
+5 DO ^%ZISC
+6 QUIT
