- 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
- 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
