APCLRX9P ; IHS/CMI/LAB - RX DISPENSED DATE/TIME ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
START ;
S (APCLTOT,APCLPG)=0 D HEAD
K APCLQUIT
D PRINT
;
DONE ;
D DONE^APCLOSUT
K ^XTMP("APCLAP9",APCLJOB,APCLBT)
Q
PRINT ;
W !,"DIVISION: ",$S(APCLDIVN="":"ALL DIVISIONS",1:APCLDIVN)
W !,"RX RELEASE DATE RANGE: ",$$FMTE^XLFDT(APCLBD)," - ",$$FMTE^XLFDT(APCLED)
W !!,"Total Prescriptions Dispensed: ",APCLGTOT,!
W ?35,"RX COUNT",?50,"ACT % TOTAL",?65,"ADJ % TOTAL"
W !,?35,"________",?50,"__________",?65,"___________",!
TYPE ;
I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)
PRINTRX ;Set % of Total Variables
I 'APCLGTOT D NONE Q
S APCLRX1=APCL1/APCLGTOT*100
S APCLRX2=APCL2/APCLGTOT*100
S APCLRX3=APCL3/APCLGTOT*100
S APCLRX4=APCL4/APCLGTOT*100
S APCLRX5=APCL5/APCLGTOT*100
S APCLRX6=APCL6/APCLGTOT*100
S APCLRX7=APCL7/APCLGTOT*100
S APCLRX8=APCL8/APCLGTOT*100
S APCLRX9=APCL9/APCLGTOT*100
S APCLRX10=APCL10/APCLGTOT*100
S APCLRX11=APCL11/APCLGTOT*100
S APCLRX12=APCL12/APCLGTOT*100
S APCLRX13=APCL13/APCLGTOT*100
S APCLRX14=APCL14/APCLGTOT*100
S APCLRX15=APCL15/APCLGTOT*100
S APCLRX16=APCL16/APCLGTOT*100
S APCLRX17=APCL17/APCLGTOT*100
;
ADJ ;Set Adjustment Variables (After 9:00)
;(Grand Total minus Before 8 & Between 8-9 am)
S APCLJ=APCLGTOT-APCL1-APCL2
;IHS/PIMC/WAR 10/23/2006 - REM'd next 15 SET commands
;S APCLJ3=APCL3/APCLJ*100
;S APCLJ4=APCL4/APCLJ*100
;S APCLJ5=APCL5/APCLJ*100
;S APCLJ6=APCL6/APCLJ*100
;S APCLJ7=APCL7/APCLJ*100
;S APCLJ8=APCL8/APCLJ*100
;S APCLJ9=APCL9/APCLJ*100
;S APCLJ10=APCL10/APCLJ*100
;S APCLJ11=APCL11/APCLJ*100
;S APCLJ12=APCL12/APCLJ*100
;S APCLJ13=APCL13/APCLJ*100
;S APCLJ14=APCL14/APCLJ*100
;S APCLJ15=APCL15/APCLJ*100
;S APCLJ16=APCL16/APCLJ*100
;S APCLJ17=APCL17/APCLJ*100
;IHS/PIMC/WAR 10/23/06 added new code from here to end of mod
S (APCLJ3,APCLJ4,APCLJ5,APCLJ6,APCLJ7,APCLJ8,APCLJ9,APCLJ10)=0
S (APCLJ11,APCLJ12,APCLJ13,APCLJ14,APCLJ15,APCLJ16,APCLJ17)=0
I APCLJ'=0 D
.S APCLJ3=APCL3/APCLJ*100
.S APCLJ4=APCL4/APCLJ*100
.S APCLJ5=APCL5/APCLJ*100
.S APCLJ6=APCL6/APCLJ*100
.S APCLJ7=APCL7/APCLJ*100
.S APCLJ8=APCL8/APCLJ*100
.S APCLJ9=APCL9/APCLJ*100
.S APCLJ10=APCL10/APCLJ*100
.S APCLJ11=APCL11/APCLJ*100
.S APCLJ12=APCL12/APCLJ*100
.S APCLJ13=APCL13/APCLJ*100
.S APCLJ14=APCL14/APCLJ*100
.S APCLJ15=APCL15/APCLJ*100
.S APCLJ16=APCL16/APCLJ*100
.S APCLJ17=APCL17/APCLJ*100
;IHS/PIMC/WAR 10/11/2006 end mod
AFTER ;Set Variables for after 2 and 3 percentages
;After 2 and After 3 Counts and Percentage Variables
S APCLA2P=APCLRX8+APCLRX9+APCLRX10+APCLRX11+APCLRX12+APCLRX13+APCLRX14+APCLRX15+APCLRX16+APCLRX17 ;TOTAL percentage after 2pm
S APCLA3P=APCLRX9+APCLRX10+APCLRX11+APCLRX12+APCLRX13+APCLRX14+APCLRX15+APCLRX16+APCLRX17 ;TOTAL percentage after 3pm
S APCLA2AP=APCLJ8+APCLJ9+APCLJ10+APCLJ11+APCLJ12+APCLJ13+APCLJ14+APCLJ15+APCLJ16+APCLJ17 ;ADJ percentage after 2pm
S APCLA3AP=APCLJ9+APCLJ10+APCLJ11+APCLJ12+APCLJ13+APCLJ14+APCLJ15+APCLJ16+APCLJ17 ;ADJ percentage after 3pm
;After 4pm Counts and percentages
S APCLA4P=APCLRX10+APCLRX11+APCLRX12+APCLRX13+APCLRX14+APCLRX15+APCLRX16+APCLRX17 ; Total percentage after 4pm
S APCLA4AP=APCLJ10+APCLJ11+APCLJ12+APCLJ13+APCLJ14+APCLJ15+APCLJ16+APCLJ17 ;ADJ percentage after 4pm
WRITES ;Write the values
I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)
W !,"**AM Prescriptions Dispensed**",!
W "******************************",!
W "Total RX's Before 8:00: ",?40,APCL1,?55,$J(APCLRX1,3,0),?71,"NA",!
W "Total RX's 8:00- 8:59: ",?40,APCL2,?55,$J(APCLRX2,3,0),?71,"NA",!
W "Total RX's 9:00- 9:59: ",?40,APCL3,?55,$J(APCLRX3,3,0),?70,$J(APCLJ3,3,0),!
W "Total RX's 10:00-10:59: ",?40,APCL4,?55,$J(APCLRX4,3,0),?70,$J(APCLJ4,3,0),!
W "Total RX's 11:00-11:59: ",?40,APCL5,?55,$J(APCLRX5,3,0),?70,$J(APCLJ5,3,0),!
W !,"**PM Prescriptions Dispensed**",!
W "******************************",!
W "Total RX's 12:00-12:59: ",?40,APCL6,?55,$J(APCLRX6,3,0),?70,$J(APCLJ6,3,0),!
W "Total RX's 1:00- 1:59: ",?40,APCL7,?55,$J(APCLRX7,3,0),?70,$J(APCLJ7,3,0),!
W "Total RX's 2:00- 2:59: ",?40,APCL8,?55,$J(APCLRX8,3,0),?70,$J(APCLJ8,3,0),!
W "Total RX's 3:00- 3:59: ",?40,APCL9,?55,$J(APCLRX9,3,0),?70,$J(APCLJ9,3,0),!
W "Total RX's 4:00- 4:59: ",?40,APCL10,?55,$J(APCLRX10,3,0),?70,$J(APCLJ10,3,0),!
W "Total RX's 5:00- 5:59: ",?40,APCL11,?55,$J(APCLRX11,3,0),?70,$J(APCLJ11,3,0),!
W "Total RX's 6:00- 6:59: ",?40,APCL12,?55,$J(APCLRX12,3,0),?70,$J(APCLJ12,3,0),!
W "Total RX's 7:00- 7:59: ",?40,APCL13,?55,$J(APCLRX13,3,0),?70,$J(APCLJ13,3,0),!
W "Total RX's 8:00- 8:59: ",?40,APCL14,?55,$J(APCLRX14,3,0),?70,$J(APCLJ14,3,0),!
W "Total RX's 9:00- 9:59: ",?40,APCL15,?55,$J(APCLRX15,3,0),?70,$J(APCLJ15,3,0),!
W "Total RX's 10:00-10:59: ",?40,APCL16,?55,$J(APCLRX16,3,0),?70,$J(APCLJ16,3,0),!
W "Total RX's 11:00-11:59: ",?40,APCL17,?55,$J(APCLRX17,3,0),?70,$J(APCLJ17,3,0),!
;
W ?35,"________",?53,"________",?69,"________",!
W ?39,APCLGTOT,?55,"100%",?70,"100%",!
;
SUMMARY ;Summary Counts and percentages
W !,?30,"***SUMMARY***",!
W "ACT Total-All Hours: ",?30,APCLGTOT,?40,"ADJ Total After 9:00 AM: ",?71,APCLJ,!
W "ACT Percent After 2:00 PM: ",?29,$J(APCLA2P,3,0)_"%",?40,"ADJ Percent After 2:00 PM: ",?70,$J(APCLA2AP,3,0)_"%",!
W "ACT Percent After 3:00 PM: ",?29,$J(APCLA3P,3,0)_"%",?40,"ADJ Percent After 3:00 PM: ",?70,$J(APCLA3AP,3,0)_"%",!
W "ACT Percent After 4:00 PM: ",?29,$J(APCLA4P,3,0)_"%",?40,"ADJ Percentage After 4:00 PM: ",?70,$J(APCLA4AP,3,0),"%",!
NOTE ;Notes at bottom of Report
W ?30,"*************",!
W "NOTE: ACT Total includes all hours - ADJ Total excludes all Non-Pharmacy",!,"and evening dispensed RX's that are typically encoded between 8:00-9:00 AM.",!
Q
HEAD I 'APCLPG G HEAD1
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCLQUIT="" Q
HEAD1 ;
W:$D(IOF) @IOF S APCLPG=APCLPG+1
W !?3,$P(^DIC(4,DUZ(2),0),U),?58,$$FMTE^XLFDT(DT),?72,"Page ",APCLPG,!
W ?28,"RX ANALYSIS REPORT",!
W ?20,"RX RELEASE TIME WORKLOAD DISTRIBUTION",!
W $TR($J("",80)," ","*"),!
Q
NONE ;IHS/PIMC/WAR 10/11/2006 - new SubRtn added
D ^XBON
W !!,"No Prescriptions dispensed, thus no counts to report"
D ^XBOFF
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCLQUIT=""
;IHS/PIMC/WAR 10/11/2006 end mod
Q
APCLRX9P ; IHS/CMI/LAB - RX DISPENSED DATE/TIME ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
START ;
+1 SET (APCLTOT,APCLPG)=0
DO HEAD
+2 KILL APCLQUIT
+3 DO PRINT
+4 ;
DONE ;
+1 DO DONE^APCLOSUT
+2 KILL ^XTMP("APCLAP9",APCLJOB,APCLBT)
+3 QUIT
PRINT ;
+1 WRITE !,"DIVISION: ",$SELECT(APCLDIVN="":"ALL DIVISIONS",1:APCLDIVN)
+2 WRITE !,"RX RELEASE DATE RANGE: ",$$FMTE^XLFDT(APCLBD)," - ",$$FMTE^XLFDT(APCLED)
+3 WRITE !!,"Total Prescriptions Dispensed: ",APCLGTOT,!
+4 WRITE ?35,"RX COUNT",?50,"ACT % TOTAL",?65,"ADJ % TOTAL"
+5 WRITE !,?35,"________",?50,"__________",?65,"___________",!
TYPE ;
+1 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
PRINTRX ;Set % of Total Variables
+1 IF 'APCLGTOT
DO NONE
QUIT
+2 SET APCLRX1=APCL1/APCLGTOT*100
+3 SET APCLRX2=APCL2/APCLGTOT*100
+4 SET APCLRX3=APCL3/APCLGTOT*100
+5 SET APCLRX4=APCL4/APCLGTOT*100
+6 SET APCLRX5=APCL5/APCLGTOT*100
+7 SET APCLRX6=APCL6/APCLGTOT*100
+8 SET APCLRX7=APCL7/APCLGTOT*100
+9 SET APCLRX8=APCL8/APCLGTOT*100
+10 SET APCLRX9=APCL9/APCLGTOT*100
+11 SET APCLRX10=APCL10/APCLGTOT*100
+12 SET APCLRX11=APCL11/APCLGTOT*100
+13 SET APCLRX12=APCL12/APCLGTOT*100
+14 SET APCLRX13=APCL13/APCLGTOT*100
+15 SET APCLRX14=APCL14/APCLGTOT*100
+16 SET APCLRX15=APCL15/APCLGTOT*100
+17 SET APCLRX16=APCL16/APCLGTOT*100
+18 SET APCLRX17=APCL17/APCLGTOT*100
+19 ;
ADJ ;Set Adjustment Variables (After 9:00)
+1 ;(Grand Total minus Before 8 & Between 8-9 am)
+2 SET APCLJ=APCLGTOT-APCL1-APCL2
+3 ;IHS/PIMC/WAR 10/23/2006 - REM'd next 15 SET commands
+4 ;S APCLJ3=APCL3/APCLJ*100
+5 ;S APCLJ4=APCL4/APCLJ*100
+6 ;S APCLJ5=APCL5/APCLJ*100
+7 ;S APCLJ6=APCL6/APCLJ*100
+8 ;S APCLJ7=APCL7/APCLJ*100
+9 ;S APCLJ8=APCL8/APCLJ*100
+10 ;S APCLJ9=APCL9/APCLJ*100
+11 ;S APCLJ10=APCL10/APCLJ*100
+12 ;S APCLJ11=APCL11/APCLJ*100
+13 ;S APCLJ12=APCL12/APCLJ*100
+14 ;S APCLJ13=APCL13/APCLJ*100
+15 ;S APCLJ14=APCL14/APCLJ*100
+16 ;S APCLJ15=APCL15/APCLJ*100
+17 ;S APCLJ16=APCL16/APCLJ*100
+18 ;S APCLJ17=APCL17/APCLJ*100
+19 ;IHS/PIMC/WAR 10/23/06 added new code from here to end of mod
+20 SET (APCLJ3,APCLJ4,APCLJ5,APCLJ6,APCLJ7,APCLJ8,APCLJ9,APCLJ10)=0
+21 SET (APCLJ11,APCLJ12,APCLJ13,APCLJ14,APCLJ15,APCLJ16,APCLJ17)=0
+22 IF APCLJ'=0
Begin DoDot:1
+23 SET APCLJ3=APCL3/APCLJ*100
+24 SET APCLJ4=APCL4/APCLJ*100
+25 SET APCLJ5=APCL5/APCLJ*100
+26 SET APCLJ6=APCL6/APCLJ*100
+27 SET APCLJ7=APCL7/APCLJ*100
+28 SET APCLJ8=APCL8/APCLJ*100
+29 SET APCLJ9=APCL9/APCLJ*100
+30 SET APCLJ10=APCL10/APCLJ*100
+31 SET APCLJ11=APCL11/APCLJ*100
+32 SET APCLJ12=APCL12/APCLJ*100
+33 SET APCLJ13=APCL13/APCLJ*100
+34 SET APCLJ14=APCL14/APCLJ*100
+35 SET APCLJ15=APCL15/APCLJ*100
+36 SET APCLJ16=APCL16/APCLJ*100
+37 SET APCLJ17=APCL17/APCLJ*100
End DoDot:1
+38 ;IHS/PIMC/WAR 10/11/2006 end mod
AFTER ;Set Variables for after 2 and 3 percentages
+1 ;After 2 and After 3 Counts and Percentage Variables
+2 ;TOTAL percentage after 2pm
SET APCLA2P=APCLRX8+APCLRX9+APCLRX10+APCLRX11+APCLRX12+APCLRX13+APCLRX14+APCLRX15+APCLRX16+APCLRX17
+3 ;TOTAL percentage after 3pm
SET APCLA3P=APCLRX9+APCLRX10+APCLRX11+APCLRX12+APCLRX13+APCLRX14+APCLRX15+APCLRX16+APCLRX17
+4 ;ADJ percentage after 2pm
SET APCLA2AP=APCLJ8+APCLJ9+APCLJ10+APCLJ11+APCLJ12+APCLJ13+APCLJ14+APCLJ15+APCLJ16+APCLJ17
+5 ;ADJ percentage after 3pm
SET APCLA3AP=APCLJ9+APCLJ10+APCLJ11+APCLJ12+APCLJ13+APCLJ14+APCLJ15+APCLJ16+APCLJ17
+6 ;After 4pm Counts and percentages
+7 ; Total percentage after 4pm
SET APCLA4P=APCLRX10+APCLRX11+APCLRX12+APCLRX13+APCLRX14+APCLRX15+APCLRX16+APCLRX17
+8 ;ADJ percentage after 4pm
SET APCLA4AP=APCLJ10+APCLJ11+APCLJ12+APCLJ13+APCLJ14+APCLJ15+APCLJ16+APCLJ17
WRITES ;Write the values
+1 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+2 WRITE !,"**AM Prescriptions Dispensed**",!
+3 WRITE "******************************",!
+4 WRITE "Total RX's Before 8:00: ",?40,APCL1,?55,$JUSTIFY(APCLRX1,3,0),?71,"NA",!
+5 WRITE "Total RX's 8:00- 8:59: ",?40,APCL2,?55,$JUSTIFY(APCLRX2,3,0),?71,"NA",!
+6 WRITE "Total RX's 9:00- 9:59: ",?40,APCL3,?55,$JUSTIFY(APCLRX3,3,0),?70,$JUSTIFY(APCLJ3,3,0),!
+7 WRITE "Total RX's 10:00-10:59: ",?40,APCL4,?55,$JUSTIFY(APCLRX4,3,0),?70,$JUSTIFY(APCLJ4,3,0),!
+8 WRITE "Total RX's 11:00-11:59: ",?40,APCL5,?55,$JUSTIFY(APCLRX5,3,0),?70,$JUSTIFY(APCLJ5,3,0),!
+9 WRITE !,"**PM Prescriptions Dispensed**",!
+10 WRITE "******************************",!
+11 WRITE "Total RX's 12:00-12:59: ",?40,APCL6,?55,$JUSTIFY(APCLRX6,3,0),?70,$JUSTIFY(APCLJ6,3,0),!
+12 WRITE "Total RX's 1:00- 1:59: ",?40,APCL7,?55,$JUSTIFY(APCLRX7,3,0),?70,$JUSTIFY(APCLJ7,3,0),!
+13 WRITE "Total RX's 2:00- 2:59: ",?40,APCL8,?55,$JUSTIFY(APCLRX8,3,0),?70,$JUSTIFY(APCLJ8,3,0),!
+14 WRITE "Total RX's 3:00- 3:59: ",?40,APCL9,?55,$JUSTIFY(APCLRX9,3,0),?70,$JUSTIFY(APCLJ9,3,0),!
+15 WRITE "Total RX's 4:00- 4:59: ",?40,APCL10,?55,$JUSTIFY(APCLRX10,3,0),?70,$JUSTIFY(APCLJ10,3,0),!
+16 WRITE "Total RX's 5:00- 5:59: ",?40,APCL11,?55,$JUSTIFY(APCLRX11,3,0),?70,$JUSTIFY(APCLJ11,3,0),!
+17 WRITE "Total RX's 6:00- 6:59: ",?40,APCL12,?55,$JUSTIFY(APCLRX12,3,0),?70,$JUSTIFY(APCLJ12,3,0),!
+18 WRITE "Total RX's 7:00- 7:59: ",?40,APCL13,?55,$JUSTIFY(APCLRX13,3,0),?70,$JUSTIFY(APCLJ13,3,0),!
+19 WRITE "Total RX's 8:00- 8:59: ",?40,APCL14,?55,$JUSTIFY(APCLRX14,3,0),?70,$JUSTIFY(APCLJ14,3,0),!
+20 WRITE "Total RX's 9:00- 9:59: ",?40,APCL15,?55,$JUSTIFY(APCLRX15,3,0),?70,$JUSTIFY(APCLJ15,3,0),!
+21 WRITE "Total RX's 10:00-10:59: ",?40,APCL16,?55,$JUSTIFY(APCLRX16,3,0),?70,$JUSTIFY(APCLJ16,3,0),!
+22 WRITE "Total RX's 11:00-11:59: ",?40,APCL17,?55,$JUSTIFY(APCLRX17,3,0),?70,$JUSTIFY(APCLJ17,3,0),!
+23 ;
+24 WRITE ?35,"________",?53,"________",?69,"________",!
+25 WRITE ?39,APCLGTOT,?55,"100%",?70,"100%",!
+26 ;
SUMMARY ;Summary Counts and percentages
+1 WRITE !,?30,"***SUMMARY***",!
+2 WRITE "ACT Total-All Hours: ",?30,APCLGTOT,?40,"ADJ Total After 9:00 AM: ",?71,APCLJ,!
+3 WRITE "ACT Percent After 2:00 PM: ",?29,$JUSTIFY(APCLA2P,3,0)_"%",?40,"ADJ Percent After 2:00 PM: ",?70,$JUSTIFY(APCLA2AP,3,0)_"%",!
+4 WRITE "ACT Percent After 3:00 PM: ",?29,$JUSTIFY(APCLA3P,3,0)_"%",?40,"ADJ Percent After 3:00 PM: ",?70,$JUSTIFY(APCLA3AP,3,0)_"%",!
+5 WRITE "ACT Percent After 4:00 PM: ",?29,$JUSTIFY(APCLA4P,3,0)_"%",?40,"ADJ Percentage After 4:00 PM: ",?70,$JUSTIFY(APCLA4AP,3,0),"%",!
NOTE ;Notes at bottom of Report
+1 WRITE ?30,"*************",!
+2 WRITE "NOTE: ACT Total includes all hours - ADJ Total excludes all Non-Pharmacy",!,"and evening dispensed RX's that are typically encoded between 8:00-9:00 AM.",!
+3 QUIT
HEAD IF 'APCLPG
GOTO HEAD1
+1 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET APCLQUIT=""
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET APCLPG=APCLPG+1
+2 WRITE !?3,$PIECE(^DIC(4,DUZ(2),0),U),?58,$$FMTE^XLFDT(DT),?72,"Page ",APCLPG,!
+3 WRITE ?28,"RX ANALYSIS REPORT",!
+4 WRITE ?20,"RX RELEASE TIME WORKLOAD DISTRIBUTION",!
+5 WRITE $TRANSLATE($JUSTIFY("",80)," ","*"),!
+6 QUIT
NONE ;IHS/PIMC/WAR 10/11/2006 - new SubRtn added
+1 DO ^XBON
+2 WRITE !!,"No Prescriptions dispensed, thus no counts to report"
+3 DO ^XBOFF
+4 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET APCLQUIT=""
+5 ;IHS/PIMC/WAR 10/11/2006 end mod
+6 QUIT
