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

AZFMCM.m

Go to the documentation of this file. 
  1. AZFMCM ;IHS/OHPRD/JCM;MOST COMMON DRUGS[ 02/03/95  8:21 AM ]
  1.  ;;5.06;PS;;JUL 12, 1990
  1.  ; IHS/OHPRD/JCM 11/15/89 Inserted line after CONVERT+0
  1.  ;THIS ROUTINE BUILDS THE MOST COMMONLY PRESCRIBED DRUGS GLOBAL
  1.  ;IT RUNS AND THEN CALLS PSOZCOM1 TO DO THE ACUTAL PRINT OF LIST
  1.  ;
  1.  ;OUTPUT VARIABLES: BD,ED,DATE,DRGNAME,IRXN,PSZCNT,RNUM,X,Y,I,TAB
  1.  ;^TMP("PSOZCOM2",$J,
  1.  ;^TMP("PSOZCOM1,$J,ZTIO,%IS,ZTSAVE("BD"),ZTSAVE("ED"),ZTDESC,ZTRTN
  1.  ;
  1.  ;EXTERNAL CALLS: ^%DT,^%ZIS,^PSOZCOM1,^%ZTLOAD
  1.  ;^PSDRUG,^PSRX
  1. INIT ;
  1.  K ^TMP("PSOZCOM1",$J),^TMP("PSOZCOM2",$J)
  1.  W @IOF
  1.  W "Pharmacy Dispensed Drug List ",!!
  1.  S %DT("A")="PLEASE ENTER BEGINNING DATE: "
  1.  S %DT="AE"
  1.  D ^%DT
  1.  I Y=-1 G EXIT
  1.  S BD=Y
  1.  S %DT("A")="PLEASE ENTER ENDING DATE: "
  1.  D ^%DT
  1.  I Y=-1 G:X="" INIT G EXIT
  1.  S ED=Y
  1. CNT ;R !,"DO NOT PRINT DRUG IF COUNT IS LESS THAN: 20//",X:DTIME S:X="" X=20
  1.  ;G:"^"[X!('$T) AZFMCM I +X'=X W !?5,*7,"PLEASE ENTER A NUMBER." G CNT
  1.  ;S PSZCNT=9999999-X
  1. QUE ;
  1.  W !
  1.  S %IS="QM"
  1.  D ^%ZIS
  1.  I POP G EXIT
  1.  I $D(IO("Q")),IO=IO(0) W !!,"Sorry, you cannot queue to your screen or to a slave printer.",! K IO("Q") G QUE
  1.  I IO=IO(0)!('$D(IO("Q"))) G DATE
  1.  S ZTRTN="DATE^AZFMCM",ZTIO=IO,ZTSAVE("BD")="",ZTSAVE("ED")=""
  1.  S ZTSAVE("PSZCNT")="",ZTDESC="PHARMACY COMMON DRUG LISTING"
  1.  D ^%ZTLOAD
  1.  G EXIT
  1. DATE ;
  1.  F DATE=(BD-1):0 S DATE=$O(^PSRX("AD",DATE)) Q:(DATE>ED)!(DATE="")  D RX
  1.  ;BUILD DESCENDING ORDER ARRAY
  1.  ;S DRGNAME=0,APSPOU=0
  1.  ;F I=0:0 S DRGNAME=$O(^TMP("PSOZCOM1",$J,DRGNAME)) Q:DRGNAME=""  F  S APSPOU=$O(^TMP("PSOZCOM1",$J,DRGNAME,APSPOU)) Q:APSPOU=""  D
  1.  ;.S RNUM=9999999-$P(^TMP("PSOZCOM1",$J,DRGNAME,APSPOU),U,3),^TMP("PSOZCOM2",$J,RNUM,DRGNAME,APSPOU)=^TMP("PSOZCOM1",$J,DRGNAME,APSPOU)
  1.  D ^AZFMCM1
  1.  K:$D(ZTSK) ^%ZTSK(ZTSK)
  1. EXIT ;
  1.  K ^TMP("PSOZCOM1",$J)
  1.  K ^TMP("PSOZCOM2",$J)
  1.  K BD,ED,ZTRTN,ZTIO,ZTSAVE("ED"),IRXN,DATE,RNUM,PSZCNT
  1.  K ZTSAVE,ZTDESC,%IS,POP,ZTSK,%DT
  1.  K DRGNAME,DRGNUM,UTL,IO("C"),I,X,Y,IO("Q"),TAB
  1.  Q
  1. RX ;
  1.  ;IRXN IS THE SUBSCRIPT PRESCRIPTION NUMBER
  1.  F IRXN=0:0 S IRXN=$O(^PSRX("AD",DATE,IRXN)) Q:IRXN=""  D CHECK
  1.  Q
  1. CHECK ;
  1.  Q:'$D(^PSRX(IRXN,0))
  1.  S PSFILL=$S($N(^PSRX("AD",DATE,IRXN,-1))=0:1,1:2) ;ORIGINAL OR REFILL
  1.  ;DSD/ENM
  1.  S DRGNUM=$P(^PSRX(IRXN,0),"^",6),QTY=$P(^(0),"^",7) ;DRUG NUMBER FOR THE DRUG FILE
  1.  I '$D(^PSDRUG(DRGNUM,0)) Q
  1.  Q:$P(^PSDRUG(DRGNUM,0),U,1)=""
  1.  ;DSD/ENM
  1.  S DRGNAME=$P(^PSDRUG(DRGNUM,0),U,1),APSPOU=$P($G(^PSDRUG(DRGNUM,660)),"^",8) I APSPOU="" S APSPOU="UNK" G APSP
  1. APSP ;I DRGNAME'["U/D",DRGNAME[" TAB"!(DRGNAME[" CAP") D CONVERT
  1.  ;IHS/ENM
  1.  S:'$D(^TMP("PSOZCOM1",$J,DRGNAME,APSPOU)) ^TMP("PSOZCOM1",$J,DRGNAME,APSPOU)="0^0^0^0"
  1.  S UTL=^TMP("PSOZCOM1",$J,DRGNAME,APSPOU)
  1.  S $P(UTL,U,PSFILL)=$P(UTL,U,PSFILL)+1
  1.  S $P(UTL,U,3)=$P(UTL,U,3)+1
  1.  S $P(UTL,U,4)=$P(UTL,U,4)+QTY
  1.  S ^TMP("PSOZCOM1",$J,DRGNAME,APSPOU)=UTL
  1.  ;W !,DRGNAME,?30,QTY
  1.  K UTL,PSFILL,DRGNAME,DRGNUM,QTY
  1.  Q
  1.  ;
  1. CONVERT ; Strips TAB or CAP from Drug Name
  1.  Q:$P(DRGNAME," ",1)["TAB"!($P(DRGNAME," ",1)["CAP")  ;IHS/OHPRD/JCM 11/15/89
  1.  S TAB=$S(DRGNAME["TAB":$F(DRGNAME," TAB"),1:$F(DRGNAME," CAP"))
  1.  S DRGNAME=$E(DRGNAME,1,(TAB-4))
  1.  Q