Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: APCLRX9P

APCLRX9P.m

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