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