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

PSOCST10.m

Go to the documentation of this file.
  1. PSOCST10 ;BHAM ISC/SAB - high cost report ; 12/16/14 8:53am
  1. ;;7.0;OUTPATIENT PHARMACY;**31,56,331,398,452**;DEC 1997;Build 56
  1. ;this routine list rxs that cost over a specified $ amount for a specified date range
  1. ;External Ref. ^PSDRUG( is supp. by DBIA# 221
  1. BEG W ! S %DT(0)=-DT,%DT("A")="Beginning Date: ",%DT="APE" D ^%DT G:Y<0!($D(DTOUT)) EXIT S (%DT(0),BEGDATE)=Y
  1. W ! S %DT("A")="Ending Date: " D ^%DT G:Y<0!($D(DTOUT)) EXIT S ENDDATE=Y D:+$E(Y,6,7)=0 DTC
  1. MAX K DIR S DIR("A")="Dollar Limit ",DIR("B")=30,DIR(0)="N^0:9999:2",DIR("?")="Enter a dollar amount between 0-9999 with no more than two decimals or ^ quit"
  1. D ^DIR K DIR G:$D(DIRUT) EXIT S MAX=Y
  1. ; BEGIN prompt for selection of Outpatient Site(s) //rtw
  1. N @($$DIR^PSODIR4()),PSOSITE D OPTSITE^PSODIR4(.PSOSITE,$T(+0),1) G:PSOSITE="^" EXIT
  1. ; END prompt for selection of Outpatient Site(s)
  1. DEV K %ZIS,IOP,POP,ZTSK S PSOION=ION,%ZIS="QM" D ^%ZIS K %ZIS I POP S IOP=PSOION D ^%ZIS K IOP,PSOION W !,"Please try later!" G EXIT
  1. K PSOION I $D(IO("Q")) D G EXIT
  1. .S ZTDESC="Outpatient High Cost Report",ZTRTN="START^PSOCST10" F G="BEGDATE","ENDDATE","MAX" S:$D(@G) ZTSAVE(G)=""
  1. .; Begin save & pass PSOSITE* to tasked entry point //rtw
  1. .S ZTSAVE("PSOSITE*")=""
  1. .; End save & pass PSOSITE* to tasked entry point /rtw
  1. .K IO("Q") D ^%ZTLOAD W:$D(ZTSK) !,"Report is Queued to print !!" K ZTSK
  1. START U IO S PAGE=1,(CNT,TCOST)=0 D HD
  1. F NDT=BEGDATE:1:ENDDATE F PSOTY="AL","AM" S PSDT=NDT-1_".999999" D ST1 Q:$D(DIRUT) ;*331
  1. Q:$D(DIRUT) D HD:($Y+4)>IOSL
  1. D:'$D(DIRUT) FT
  1. EXIT W ! D ^%ZISC K XTYPE,DIR,DTOUT,DUOUT,DIROUT,DIRUT,^TMP($J),NDT,PSOTY,BEGDATE,CNT,COST,TCOST,DR0,DRCST,ENDDATE,MAX,PAGE,PGM,POP,PSDT,PSFILL,PSRXN,QTY,RX0,RX1,VAR,X,Y,%DT
  1. S:$D(ZTQUEUED) ZTREQ="@" Q
  1. ST1 F S PSDT=$O(^PSRX(PSOTY,PSDT)) Q:'PSDT!(PSDT>(NDT_".999999")) D ST2 Q:$D(DIRUT)
  1. Q
  1. ST2 S PSRXN=0 F S PSRXN=$O(^PSRX(PSOTY,PSDT,PSRXN)) Q:'PSRXN D ST3 Q:$D(DIRUT)
  1. Q
  1. ST3 S PSFILL=""
  1. F S PSFILL=$O(^PSRX(PSOTY,PSDT,PSRXN,PSFILL)) Q:PSFILL="" D CHK Q:$D(DIRUT)
  1. Q
  1. CHK Q:'$D(^PSRX(PSRXN,0))!(+$P(^PSRX(PSRXN,"STA"),"^")=13) S RX0=^(0) Q:'$D(^PSDRUG(+$P(RX0,"^",6),0)) S DR0=^(0)
  1. I PSOTY="AL" S:PSFILL RX1=$G(^PSRX(PSRXN,1,PSFILL,0)) Q:PSFILL&($G(RX1)="")
  1. I PSOTY="AM" Q:'$P($G(^PSRX(PSRXN,"P",PSFILL,0)),"^",19) S RX1=^(0)
  1. ; Begin to screen RX on selected Outpatient Site(s) ;rtw
  1. Q:'$$DIVOK^PSODIR4(.PSOSITE,PSOTY,PSRXN,PSFILL)
  1. ; End screen of RX on selected Outpatient Site(s) ;rtw
  1. S DRCST=$S('PSFILL&(+$P(RX0,"^",17)):$P(RX0,"^",17),PSFILL&(+$P($G(RX1),"^",11)):$P($G(RX1),"^",11),1:0)
  1. S QTY=$S('PSFILL:+$P(RX0,"^",7),1:+$P(RX1,"^",4))
  1. I 'DRCST S DRCST=$S($P($G(^PSDRUG(+$P(RX0,"^",6),660)),"^",6):+$P(^(660),"^",6),1:0)
  1. S COST=QTY*DRCST Q:COST<MAX
  1. Q:$D(DIRUT) D HD:($Y+4)>IOSL
  1. Q:$D(DIRUT) W !,$S(PSFILL&(PSOTY="AL"):"*",PSOTY="AM":"%",1:" ")_$P(RX0,"^"),?11,$E($P(DR0,"^"),"^",40),?51,$J(QTY,6),?60,$J(DRCST,6,3),?68,$J(COST,12,2) S CNT=CNT+1,TCOST=TCOST+COST
  1. Q
  1. HD I PAGE>1,$E(IOST)="C" S DIR(0)="E",DIR("A")=" Press Return to Continue or ^ to Exit" D ^DIR K DIR
  1. Q:$D(DIRUT) W @IOF,!,"Fills That Cost at Least $"_MAX_" for the Period: " S Y=BEGDATE D DT^DIO2 W " to " S Y=ENDDATE D DT^DIO2 W ?72,"Page "_PAGE,!,"Run Date: " S Y=DT D DT^DIO2 S PAGE=PAGE+1
  1. ; Begin display selected Outpatient Site(s) //rtw
  1. N PSOLTIEN,PSOIEN59,PSOSTANM
  1. W !,"Outpatient Site" I PSOSITE("PSOSCNT")>1 W "s"
  1. W " Included in this Report: " I PSOSITE("PSOSCNT")>1 W !?2
  1. S PSOLTIEN=$O(PSOSITE(":"),-1) ; Do not append a comma on last site
  1. S PSOIEN59=0 F S PSOIEN59=$O(PSOSITE(PSOIEN59)) Q:'PSOIEN59 D ;
  1. . ; Format PSOSTANM variable, for example: JOHN COCHRAN VAMC (657)
  1. . S PSOSTANM=PSOSITE(PSOIEN59)_" ("_$$GET1^DIQ(59,PSOIEN59,.06)_")"
  1. . I PSOIEN59'=PSOLTIEN S PSOSTANM=PSOSTANM_", " ; Format multiples sites w/comma separation
  1. . I $X+($L(PSOSTANM)+2)>(IOM-1) W !?2 ; Issue line feed if IOM exceeded
  1. . W PSOSTANM
  1. ; End display selected Outpatient Site(s) //rtw
  1. W !!,"Rx #",?11,"Drug",?54,"QTY",?59,"Un.Cost",?70,"Total Cost"
  1. W ! F I=1:1:80 W "-"
  1. Q
  1. FT W ! F I=1:1:80 W "-"
  1. S TCOST="Total Cost = "_$FN(TCOST,",",2)
  1. W !,"No. of Fills = "_CNT,?50,$J(TCOST,30)
  1. W ! F I=1:1:80 W "-"
  1. W !,"(* indicates a refill, % indicates a partial) "
  1. Q
  1. DTC N DD,MM S DD=31,MM=+$E(Y,4,5) I MM'=12 S MM=MM+1,MM=$S(MM<10:"0",1:"")_MM,X2=Y,X1=$E(Y,1,3)_MM_"00" D ^%DTC S DD=X
  1. S ENDDATE=Y+DD
  1. Q