IBARXEC1 ;ALB/AAS - RX CO-PAY EXEMPTION REPORT GENERATOR ; 04-JAN-93
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
% ;
START ; -- entry point for running conversion report from option
D HOME^%ZIS W @IOF,?15,"Medication Copayment Charges Retroactively Canceled",!!
;
I '$P(^IBE(350.9,1,3),"^",14) W !!,"This report cannot be run until the conversion has completed." G END
;
BDT ; -get beginning date
S (IBBDT,IBEDT)=""
S Y=$$STDATE^IBARXEU D D^DIQ S %DT("B")=Y
S %DT="AEPX",%DT("A")="Start with DATE: " D ^%DT K %DT G END:Y<0 S IBBDT=Y
K %DT W !
;
EDT ; -get ending date
S Y=$P($P(^IBE(350.9,1,3),"^",14),".") D D^DIQ S %DT("B")=Y
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
K %DT W !
;
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
;
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="REPORT^IBARXEC1",ZTSAVE("IB*")="",ZTDESC="IB Medication Copayment Exemption Conversion Report" D ^%ZTLOAD K ZTSK D HOME^%ZIS G END
;
REPORT ; -- run report for conversion
I $D(IBCONVER) D
.D QUIC
.Q:IO'=IO(0)
.I '$D(ZTQUEUED) W !!,"Please wait while I compile the report by patient...."
.W !!,"This report can be re-run by re-running the conversion",!,"or using the option provided."
.S IBBDT=$$STDATE^IBARXEU
.S IBEDT=$P(^IBE(350.9,1,3),"^",14)
.Q
;
U IO
Q:'$P(^IBE(350.9,1,3),"^",14)
;
S IBQUIT=0
I $G(IBQUIC)=1 D QUIC
D BUILD^IBARXEC4
D PRINT^IBARXEC5
;
END K ^TMP("IBCONV",$J)
I $D(ZTQUEUED) S ZTREQ="@" Q
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
D END^IBARXEC
Q
;
QUIC ; -- quick summary
I '$D(IOF) D HOME^%ZIS
N IBX,X,X1,X2,X3,Y
S IBX=$G(^IBE(350.9,1,3)),X3=10
;
W @IOF,?20,"Medication Copayment Exemption Conversion Status"
I '$P(IBX,"^",3),'$P(IBX,"^",13) W !!,"Conversion has not been started" Q
I $P(IBX,"^",3)>1 W !!,"The conversion has been started ",$P(IBX,"^",3)," times"
I $P(IBX,"^",13) W !!,"Conversion was started on: " S Y=$P(IBX,"^",13) D DT^DIQ
I $P(IBX,"^",14) W !,"The conversion completed on: " S Y=$P(IBX,"^",14) D DT^DIQ,ELAP W !,Y
W !!," Last Patient DFN Checked == ",$J(+$P(IBX,"^",4),10)
W !!," 1. Total Patients Checked == " S X=+$P(IBX,"^",5),X2=0 D COMMA^%DTC W X
W !," Exempt Patients == " S X=+$P(IBX,"^",6),X2=0 D COMMA^%DTC W X
W !," Non-Exempt Patients == " S X=+$P(IBX,"^",7),X2=0 D COMMA^%DTC W X
W !!," 2. Total Number of Rx Charges checked == " S X=+$P(IBX,"^",16),X2=0 D COMMA^%DTC W X
W !," Dollar Amount Checked == " S X=+$P(IBX,"^",9),X2="0$" D COMMA^%DTC W X
W !," No. of Exempt Rx Charges Checked == " S X=+$P(IBX,"^",8),X2=0 D COMMA^%DTC W X
W !," Exempt Dollar amount == " S X=+$P(IBX,"^",10),X2="0$" D COMMA^%DTC W X
W !," No. of Non-Exempt Rx Charges Checked == " S X=+$P(IBX,"^",15),X2=0 D COMMA^%DTC W X
W !," Non-exempt Dollar amount == " S X=+$P(IBX,"^",11),X2="0$" D COMMA^%DTC W X
W !!," 3. Total Rx Charges Actually canceled == " S X=+$P(IBX,"^",17),X2=0 D COMMA^%DTC W X
W !," Amount Actually canceled == " S X=+$P(IBX,"^",12),X2="0$" D COMMA^%DTC W X
QUICQ Q
;
ELAP ; -- calcualate elaplse running time
N X,IBBDT,IBEDT,IBDAY
S X=$P(IBX,"^",13) D H^%DTC S IBBDT=%H_","_%T
S X=$P(IBX,"^",14) D H^%DTC S IBEDT=%H_","_%T
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"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBARXEC1 4005 printed Dec 13, 2024@02:07:07 Page 2
IBARXEC1 ;ALB/AAS - RX CO-PAY EXEMPTION REPORT GENERATOR ; 04-JAN-93
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
% ;
START ; -- entry point for running conversion report from option
+1 DO HOME^%ZIS
WRITE @IOF,?15,"Medication Copayment Charges Retroactively Canceled",!!
+2 ;
+3 IF '$PIECE(^IBE(350.9,1,3),"^",14)
WRITE !!,"This report cannot be run until the conversion has completed."
GOTO END
+4 ;
BDT ; -get beginning date
+1 SET (IBBDT,IBEDT)=""
+2 SET Y=$$STDATE^IBARXEU
DO D^DIQ
SET %DT("B")=Y
+3 SET %DT="AEPX"
SET %DT("A")="Start with DATE: "
DO ^%DT
KILL %DT
if Y<0
GOTO END
SET IBBDT=Y
+4 KILL %DT
WRITE !
+5 ;
EDT ; -get ending date
+1 SET Y=$PIECE($PIECE(^IBE(350.9,1,3),"^",14),".")
DO D^DIQ
SET %DT("B")=Y
+2 SET %DT="APEX"
SET %DT("A")="Go to DATE: "
DO ^%DT
if Y<0
GOTO END
SET IBEDT=Y
IF Y<IBBDT
WRITE *7," ??",!,"ENDING DATE must follow BEGINNING DATE."
GOTO BDT
+3 KILL %DT
WRITE !
+4 ;
+5 SET DIR("A")="Print Conversion Quick Status Report with listing"
SET DIR(0)="Y"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO END
SET IBQUIC=Y
+6 ;
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="REPORT^IBARXEC1"
SET ZTSAVE("IB*")=""
SET ZTDESC="IB Medication Copayment Exemption Conversion Report"
DO ^%ZTLOAD
KILL ZTSK
DO HOME^%ZIS
GOTO END
+3 ;
REPORT ; -- run report for conversion
+1 IF $DATA(IBCONVER)
Begin DoDot:1
+2 DO QUIC
+3 if IO'=IO(0)
QUIT
+4 IF '$DATA(ZTQUEUED)
WRITE !!,"Please wait while I compile the report by patient...."
+5 WRITE !!,"This report can be re-run by re-running the conversion",!,"or using the option provided."
+6 SET IBBDT=$$STDATE^IBARXEU
+7 SET IBEDT=$PIECE(^IBE(350.9,1,3),"^",14)
+8 QUIT
End DoDot:1
+9 ;
+10 USE IO
+11 if '$PIECE(^IBE(350.9,1,3),"^",14)
QUIT
+12 ;
+13 SET IBQUIT=0
+14 IF $GET(IBQUIC)=1
DO QUIC
+15 DO BUILD^IBARXEC4
+16 DO PRINT^IBARXEC5
+17 ;
END KILL ^TMP("IBCONV",$JOB)
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+2 KILL 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
+3 DO END^IBARXEC
+4 QUIT
+5 ;
QUIC ; -- quick summary
+1 IF '$DATA(IOF)
DO HOME^%ZIS
+2 NEW IBX,X,X1,X2,X3,Y
+3 SET IBX=$GET(^IBE(350.9,1,3))
SET X3=10
+4 ;
+5 WRITE @IOF,?20,"Medication Copayment Exemption Conversion Status"
+6 IF '$PIECE(IBX,"^",3)
IF '$PIECE(IBX,"^",13)
WRITE !!,"Conversion has not been started"
QUIT
+7 IF $PIECE(IBX,"^",3)>1
WRITE !!,"The conversion has been started ",$PIECE(IBX,"^",3)," times"
+8 IF $PIECE(IBX,"^",13)
WRITE !!,"Conversion was started on: "
SET Y=$PIECE(IBX,"^",13)
DO DT^DIQ
+9 IF $PIECE(IBX,"^",14)
WRITE !,"The conversion completed on: "
SET Y=$PIECE(IBX,"^",14)
DO DT^DIQ
DO ELAP
WRITE !,Y
+10 WRITE !!," Last Patient DFN Checked == ",$JUSTIFY(+$PIECE(IBX,"^",4),10)
+11 WRITE !!," 1. Total Patients Checked == "
SET X=+$PIECE(IBX,"^",5)
SET X2=0
DO COMMA^%DTC
WRITE X
+12 WRITE !," Exempt Patients == "
SET X=+$PIECE(IBX,"^",6)
SET X2=0
DO COMMA^%DTC
WRITE X
+13 WRITE !," Non-Exempt Patients == "
SET X=+$PIECE(IBX,"^",7)
SET X2=0
DO COMMA^%DTC
WRITE X
+14 WRITE !!," 2. Total Number of Rx Charges checked == "
SET X=+$PIECE(IBX,"^",16)
SET X2=0
DO COMMA^%DTC
WRITE X
+15 WRITE !," Dollar Amount Checked == "
SET X=+$PIECE(IBX,"^",9)
SET X2="0$"
DO COMMA^%DTC
WRITE X
+16 WRITE !," No. of Exempt Rx Charges Checked == "
SET X=+$PIECE(IBX,"^",8)
SET X2=0
DO COMMA^%DTC
WRITE X
+17 WRITE !," Exempt Dollar amount == "
SET X=+$PIECE(IBX,"^",10)
SET X2="0$"
DO COMMA^%DTC
WRITE X
+18 WRITE !," No. of Non-Exempt Rx Charges Checked == "
SET X=+$PIECE(IBX,"^",15)
SET X2=0
DO COMMA^%DTC
WRITE X
+19 WRITE !," Non-exempt Dollar amount == "
SET X=+$PIECE(IBX,"^",11)
SET X2="0$"
DO COMMA^%DTC
WRITE X
+20 WRITE !!," 3. Total Rx Charges Actually canceled == "
SET X=+$PIECE(IBX,"^",17)
SET X2=0
DO COMMA^%DTC
WRITE X
+21 WRITE !," Amount Actually canceled == "
SET X=+$PIECE(IBX,"^",12)
SET X2="0$"
DO COMMA^%DTC
WRITE X
QUICQ QUIT
+1 ;
ELAP ; -- calcualate elaplse running time
+1 NEW X,IBBDT,IBEDT,IBDAY
+2 SET X=$PIECE(IBX,"^",13)
DO H^%DTC
SET IBBDT=%H_","_%T
+3 SET X=$PIECE(IBX,"^",14)
DO H^%DTC
SET IBEDT=%H_","_%T
+4 SET IBDAY=+IBEDT-(+IBBDT)*86400
SET X=IBDAY+$PIECE(IBEDT,",",2)-$PIECE(IBBDT,",",2)
SET Y="Elapsed time for Conversion was: "_(X\3600)_" Hours, "_(X\60-(X\3600*60))_" Minutes, "_(X#60)_" Seconds"
+5 QUIT
