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

PSOSUDCN.m

Go to the documentation of this file.
  1. PSOSUDCN ;BHAM ISC/JMB-Counts of suspended Rx's by day ; 12/10/92
  1. ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
  1. I '$D(PSOPAR) D ^PSOLSET I '$D(PSOPAR) D WARN Q
  1. INIT W !!!,?5,"DAILY COUNTS OF RX'S ON SUSPENSE"
  1. S EXIT="" D DATE G:EXIT="" EXIT S %ZIS="QM" K IO("Q") D ^%ZIS K %ZIS Q:POP G:$D(IO("Q")) QUEUP
  1. START U IO S (PSD,PSDP,PST,PSTP)=0 D HD
  1. F J=(BEGDATE-1):0 S J=$O(^PS(52.5,"C",J)) Q:'J!(J>ENDDATE) D CNT D:($Y+5)>IOSL HANG,HD I PSD S Y=J X ^DD("DD") W !,?10,Y,?25,$J(PSD,9),?40,$J(PSDP,9) S (PSD,PSDP)=0
  1. D:($Y+5)>IOSL HANG,HD W !,?10,"-----------",?25,"---------",?40,"---------",!,?10,"TOTAL",?25,$J(PST,9),?40,$J(PSTP,9),! D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
  1. EXIT K %,%DT,%H,BEGDATE,DAY,DIRUT,ENDDATE,PSPOP,EXIT,POP,PSD,PSDP,PST,PSTP,J,JJ,TIM,HR,MIN,%DT,D,X,Y,Z,G,ZTRTN,ZTSAVE,ZTSK Q
  1. CNT F JJ=0:0 S JJ=$O(^PS(52.5,"C",J,JJ)) Q:'JJ I $P($G(^PS(52.5,JJ,0)),"^",6)=$G(PSOSITE) S PSD=PSD+1,PST=PST+1 S:$G(^("P"))=1 PSDP=PSDP+1,PSTP=PSTP+1
  1. Q
  1. DATE K BEGDATE,ENDDATE,%DT(0) W !!!,"**** DATE SELECTION ****"
  1. W ! S %DT="AEX",%DT("A")=" BEGIN DATE : " D ^%DT K %DT Q:Y<0 S (%DT(0),BEGDATE)=Y
  1. W ! S %DT="AEX",%DT("A")=" ENDING DATE: " D ^%DT Q:Y<0 S ENDDATE=Y
  1. S EXIT="NORMAL" Q
  1. HANG I $E(IOST)="C" W $C(7),!!,"Press RETURN to CONTINUE!!" R X:DTIME Q
  1. HD I $D(IOF),IOF]"" W @IOF
  1. D NOW^%DTC S Y=% X ^DD("DD") S DAY=$P(Y,"@"),TIM=$P(Y,"@",2)
  1. W !!,?9,"*** COUNTS OF RX'S IN SUSPENSE BY DAY ***"
  1. W !?((55-$L($P(^PS(59,$G(PSOSITE),0),"^")))\2),"FOR ",$P(^(0),"^")
  1. W !,?15,"AS OF ",DAY," AT ",TIM,!!,?10,"DATE",?25,"# OF RX'S",?40,"# PRINTED",!,?10,"-----------",?25,"---------",?40,"---------"
  1. Q
  1. QUEUP S ZTRTN="START^PSOSUDCN",ZTDESC="Outpatient Pharmacy Count of Suspensed Prescriptions" F G="PSOSITE","BEGDATE","ENDDATE" S:$D(@G) ZTSAVE(G)=""
  1. D ^%ZTLOAD G EXIT
  1. DQ K IO(0),IOP Q
  1. WARN W $C(7),!!,?5,"Site Parameters must be defined to use this option!",! Q