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

APSPSWKL.m

Go to the documentation of this file. 
  1. APSPSWKL ; IHS/MSC/PLS - PHARMACY STAFF WORKLOAD REPORT ;11-Jul-2012 17:31;PLS
  1.  ;;7.0;IHS PHARMACY MODIFICATIONS;**1013,1015**;Sep 23, 2004;Build 62
  1.  ;
  1. EN ;EP
  1.  N AOSOQ,APSPBDF,APSPEDF,APSPDIV,APSPNUM,APSPUSR,APSPNAME,APSPCNT
  1.  N APSPTOT,APSPTYP,APSPCLAS,APSPBD,APSPED,APSPDARY,APSPQ,QFLG
  1.  K ^TMP("APSPW",$J)
  1.  S APSPDIV="",APSPQ=0,APSPCNT=0,APSPTYP=0,APSPUSR=""
  1.  S APSPTOT=0_U_0_U_0    ;Total new orders ^ total refills ^ grand total
  1.  W @IOF
  1.  W !!,"Pharmacy Staff Workload Report"
  1.  D ASKDATES^APSPUTIL(.APSPBD,.APSPED,.APSPQ,DT,DT)
  1.  Q:APSPQ
  1.  S APSPBDF=$P($TR($$FMTE^XLFDT(APSPBD,"5Z"),"@"," "),":",1,2)
  1.  S APSPEDF=$P($TR($$FMTE^XLFDT(APSPED,"5Z"),"@"," "),":",1,2)
  1.  S APSPBD=APSPBD-.01,APSPED=APSPED+.99
  1.  S APSPDIV=$$DIR^APSPUTIL("Y","Would you like all pharmacy divisions","Yes",,.APSPQ)
  1.  Q:APSPQ
  1.  I APSPDIV D
  1.  .S APSPDIV="*"
  1.  E  D  Q:APSPQ
  1.  .S APSPDIV=$$GETIEN^APSPUTIL(59,"Select Pharmacy Division: ",.APSPQ)
  1.  Q:APSPQ
  1.  S APSPNUM=$$DIR^APSPUTIL("S^I:Individual Pharmacy user;A:All Pharmacy users","Lookup Individual User or List ALL Users? ","A",,.APSPQ)
  1.  I APSPNUM="A" S APSPDARY="*"
  1.  I APSPNUM="I" D
  1.  .F  D  Q:QFLG
  1.  ..S APSPUSR=$$GETIEN1^APSPUTIL(200,"Select Pharmacy User: ",-1,"B")
  1.  ..I APSPUSR<1 S QFLG=1 Q
  1.  ..S APSPCLAS=$$GET1^DIQ(200,APSPUSR,53.5)
  1.  ..S APSPNAME=$$GET1^DIQ(200,APSPUSR,.01)
  1.  ..I APSPCLAS="PHARMACIST"!(APSPCLAS="PHARMACY TECHNICIAN")!(APSPCLAS="PHARMCY PRACTITIONER")!(APSPCLAS="CLINICAL PHARMACY SPECIALIST") D
  1.  ...S APSPDARY(APSPUSR)=APSPNAME
  1.  ...S APSPCNT=APSPCNT+1
  1.  ..E  D
  1.  ...W !,APSPNAME_" is not a pharmacy user."
  1.  ..S QFLG='$$DIRYN^APSPUTIL("Want to Select Another User","No","Enter a 'Y' or 'YES' to include more pharmacy users in your search",.APSPQ)
  1.  ..S:'QFLG QFLG=APSPQ
  1.  Q:APSPQ
  1.  D DEV
  1.  Q
  1. DEV ;
  1.  N XBRP,XBNS
  1.  S XBRP="OUT^APSPSWKL"
  1.  S XBNS="APS*"
  1.  D ^XBDBQUE
  1.  Q
  1. OUT ;EP
  1.  U IO
  1.  K ^TMP($J)
  1.  D FIND(APSPBD,APSPED,"AD")  ; Regular and Refill
  1.  D PRINT
  1.  K ^TMP("APSPW",$J)
  1.  Q
  1.  ;
  1. FIND(SDT,EDT,XREF) ;EP
  1.  N RXIEN,ACTIEN,RTSDT,FILLDT,A0,FDTLP,IEN,PHARM
  1.  S FDTLP=SDT-.01
  1.  F  S FDTLP=$O(^PSRX(XREF,FDTLP)) Q:'FDTLP!(FDTLP>EDT)  D
  1.  .S RXIEN=0
  1.  .F  S RXIEN=$O(^PSRX(XREF,FDTLP,RXIEN)) Q:'RXIEN  D
  1.  ..Q:'$P(^PSRX(RXIEN,0),U,6)   ; Prescription must have a drug
  1.  ..Q:$$GET1^DIQ(52,RXIEN,100,"I")=13  ; Quit if Deleted status
  1.  ..;Removed check for POE Patch 1015
  1.  ..;Q:$$GET1^DIQ(52,RXIEN,111,"I")'=1   ; Quit if not POE entered RX
  1.  ..S IEN="" F  S IEN=$O(^PSRX(XREF,FDTLP,RXIEN,IEN)) Q:IEN=""  D
  1.  ...Q:'IEN&($$GET1^DIQ(52,RXIEN,32.1,"I"))  ; Quit if original fill and a return to stock date exists
  1.  ...Q:'$$DIVVRY(RXIEN,APSPDIV,XREF,IEN)  ;check division
  1.  ...Q:'$$DSPRDT(RXIEN,XREF,IEN)  ;check for release date
  1.  ...I IEN=0 D NEW(RXIEN,IEN)
  1.  ...I IEN>0 D REFILL(RXIEN,IEN)
  1.  Q
  1.  ;
  1. NEW(RXIEN,IEN) ;Find new prescriptions
  1.  N PHARM
  1.  S PHARM=$P($G(^PSRX(RXIEN,2)),U,3)
  1.  I APSPNUM="A" D SETNEW(PHARM)
  1.  I APSPNUM="I" D
  1.  .I $D(APSPDARY(PHARM)) D SETNEW(PHARM)
  1.  Q
  1. SETNEW(PHARM) ;Set the pharmacist data
  1.  N PHARNAME,GT,RT,NT,NP,RP,TP,DATA
  1.  I +PHARM>0 S PHARNAME=$$GET1^DIQ(200,PHARM,.01)
  1.  E  S PHARNAME="UNKNOWN"
  1.  I $D(^TMP("APSPW",$J,PHARNAME)) D
  1.  .S DATA=$G(^TMP("APSPW",$J,PHARNAME))
  1.  .S NP=$P(DATA,U,1),RP=$P(DATA,U,2),TP=$P(DATA,U,3)
  1.  .S NP=NP+1,TP=TP+1
  1.  .S ^TMP("APSPW",$J,PHARNAME)=NP_U_RP_U_TP
  1.  I '$D(^TMP("APSPW",$J,PHARNAME)) D
  1.  .S ^TMP("APSPW",$J,PHARNAME)=1_U_0_U_1
  1.  S NT=$P(APSPTOT,U,1),RT=$P(APSPTOT,U,2),GT=$P(APSPTOT,U,3)
  1.  S NT=NT+1,GT=GT+1
  1.  S APSPTOT=NT_U_RT_U_GT
  1.  Q
  1. REFILL(RXIEN,IEN) ;Find refills
  1.  N PHARM
  1.  S PHARM=$P($G(^PSRX(RXIEN,1,IEN,0)),U,5)
  1.  I APSPNUM="A" D SETRFILL(PHARM)
  1.  I APSPNUM="I" D
  1.  .I $D(APSPDARY(PHARM)) D SETRFILL(PHARM)
  1.  Q
  1. SETRFILL(PHARM) ;Set provider data
  1.  N PHARNAME,GT,RT,NT,NP,RP,TP,DATA
  1.  I +PHARM>0 S PHARNAME=$$GET1^DIQ(200,PHARM,.01)
  1.  E  S PHARNAME="UNKNOWN"
  1.  I $D(^TMP("APSPW",$J,PHARNAME)) D
  1.  .S DATA=$G(^TMP("APSPW",$J,PHARNAME))
  1.  .S NP=$P(DATA,U,1),RP=$P(DATA,U,2),TP=$P(DATA,U,3)
  1.  .S RP=RP+1,TP=TP+1
  1.  .S ^TMP("APSPW",$J,PHARNAME)=NP_U_RP_U_TP
  1.  I '$D(^TMP("APSPW",$J,PHARNAME)) D
  1.  .S ^TMP("APSPW",$J,PHARNAME)=0_U_1_U_1
  1.  S NT=$P(APSPTOT,U,1),RT=$P(APSPTOT,U,2),GT=$P(APSPTOT,U,3)
  1.  S RT=RT+1,GT=GT+1
  1.  S APSPTOT=NT_U_RT_U_GT
  1.  Q
  1.  ; Return boolean flag indicating valid pharmacy division
  1. DIVVRY(RX,DIV,TYP,SIEN) ;EP
  1.  Q:DIV="*" 1
  1.  Q $S($G(SIEN):DIV=+$P($G(^PSRX(RX,$S(TYP="ADP":"P",1:1),SIEN,0)),U,9),1:DIV=+$P(^PSRX(RX,2),U,9))
  1.  ; Return release date for dispense
  1. DSPRDT(RX,TYP,SIEN) ;EP
  1.  Q $S($G(SIEN):+$P($G(^PSRX(RX,$S(TYP="ADP":"P",1:1),SIEN,0)),U,$S(TYP="ADP":19,1:18)),1:+$P(^PSRX(RX,2),U,13))
  1. PRINT ;Print out the report
  1.  N PHARM,TOT,NUMBERS,%NEW,%RFILL
  1.  I APSPNUM="I" D PRT1
  1.  I APSPNUM="A" D PRT2
  1.  Q
  1. PRT1 ;Print individual providers
  1.  N PHARM,NUMBERS
  1.  D HDR1
  1.  S PHARM="" F  S PHARM=$O(^TMP("APSPW",$J,PHARM)) Q:PHARM=""  D
  1.  .S NUMBERS=$G(^TMP("APSPW",$J,PHARM))
  1.  .W !,PHARM,?30,$P(NUMBERS,U,1),?40,$P(NUMBERS,U,2),?50,$P(NUMBERS,U,3)
  1.  .I $Y+4>IOSL,IOST["C-" D PAUS Q:APSPQ  D HDR1
  1.  .Q:APSPQ=1
  1.  W !!,?50,"Total New RX: "_$P(APSPTOT,U,1)
  1.  W !,?50,"Total Refills: "_$P(APSPTOT,U,2)
  1.  W !,?50,"GRAND TOTAL: "_$P(APSPTOT,U,3)
  1.  Q
  1. PRT2 ;Print all providers
  1.  N PHARM,NUMBERS,NNUM,RNUM,TOT,NTOT,RTOT
  1.  D HDR2
  1.  S PHARM="" F  S PHARM=$O(^TMP("APSPW",$J,PHARM)) Q:PHARM=""  D
  1.  .S NUMBERS=$G(^TMP("APSPW",$J,PHARM))
  1.  .S NNUM=$P(NUMBERS,U,1),RNUM=$P(NUMBERS,U,2),TOT=$P(NUMBERS,U,3)
  1.  .S NTOT=$P(APSPTOT,U,1),RTOT=$P(APSPTOT,U,2)
  1.  .I NTOT=0 S %NEW=0
  1.  .E  S %NEW=$$ROUND((NNUM/NTOT),3)*100
  1.  .I RTOT=0 S %RFILL=0
  1.  .E  S %RFILL=$$ROUND((RNUM/RTOT),3)*100
  1.  .W !,PHARM,?30,NNUM,?40,%NEW,?50,RNUM,?60,%RFILL,?70,TOT
  1.  .I $Y+4>IOSL,IOST["C-" D PAUS Q:APSPQ  D HDR2
  1.  .Q:APSPQ=1
  1.  W !!,?50,"Total New RX: "_$P(APSPTOT,U,1)
  1.  W !,?50,"Total Refills: "_$P(APSPTOT,U,2)
  1.  W !,?50,"GRAND TOTAL: "_$P(APSPTOT,U,3)
  1.  Q
  1. PAUS ;
  1.  N DTOUT,DUOUT,DIR
  1.  S DIR("?")="Enter '^' to Halt or Press Return to continue"
  1.  S DIR(0)="FO",DIR("A")="Press Return to continue or '^' to Halt"
  1.  D ^DIR
  1.  I $D(DUOUT) S APSPQ=1
  1.  Q
  1. HDR1 ; Header for individual users
  1.  N LIN
  1.  I IOST["C-" W @IOF
  1.  W !,"Pharmacist Workload Report: Individual Users"
  1.  W !,"Pharmacy User",?30,"New",?40,"Refills",?50,"Total"
  1.  W ! F LIN=1:1:72 W "-"
  1.  W !
  1.  Q
  1. HDR2 ; Hader for all users
  1.  N LIN
  1.  I IOST["C-" W @IOF
  1.  W !,"Pharmacist Workload Report: All Users"
  1.  W !,"Pharmacy User",?30,"New",?40,"% total",?50,"Refills",?60,"% total",?70,"Total"
  1.  W ! F LIN=1:1:72 W "-"
  1.  W !
  1.  Q
  1. ROUND(VAL,SD) ;
  1.  Q:VAL'=+VAL!($G(SD)=0) VAL
  1.  Q +$J(VAL,0,$S($D(SD):SD,VAL<1:2,VAL<10:2,1:2))