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

AZFMCM1.m

Go to the documentation of this file.
  1. AZFMCM1 ;IHS/OHPRD/JCM;COMMON DRUG PRINT[ 02/03/95 2:25 PM ]
  1. ;;5.06;PS;;JUL 12, 1990
  1. ;THIS ROUTINE PRINTS THE PHARMACY DRUG LISTING
  1. ;IT IS CALLED BY AZFMCM
  1. ;
  1. ;INPUT VARIABLES: BD,ED,PSZCNT,^TMP("PSOZCOM2",$J)
  1. ;VARIABLES: I,X,NUM,UTL,DRGNAME
  1. ;
  1. ;EXTERNAL CALLS: NOW^%DTC,^%ZIS
  1. ;
  1. START ;INITIALIZE
  1. S (DX,DY)=1 X:$D(^%ZOSF("XY"))#2 ^("XY")
  1. U IO
  1. S PSOZCOM1("PAGE")=0,APSPO=""
  1. D HEADER
  1. ;
  1. ;START LOOP
  1. ;F NUM=0:0 S NUM=$O(^TMP("PSOZCOM2",$J,NUM)) Q:NUM=""!(NUM>PSZCNT) D DRUG
  1. D DRUG
  1. ;
  1. EXIT ;
  1. I $E(IOST,1,2)="P-" W !,@IOF
  1. X ^%ZIS("C")
  1. K NUM,DRGNAME,I,X,BD,ED,PSZCNT,UTL,PSOZCOM1,DX,DY
  1. Q
  1. PRINT ;
  1. I $Y+4>IOSL W @IOF D HEADER
  1. S UTL=^TMP("PSOZCOM1",$J,DRGNAME,APSPO)
  1. W !,DRGNAME ;DRUG NAME
  1. W ?40,$P(UTL,U,3) ;TOTAL FILLS
  1. W ?47,$P(UTL,U,1) ;NEW RXS
  1. W ?52,$P(UTL,U,2) ;REFILLS
  1. W ?60,APSPO,?70,$P(UTL,U,4)
  1. Q
  1. DRUG ;
  1. S DRGNAME=0
  1. F I=0:0 S DRGNAME=$O(^TMP("PSOZCOM1",$J,DRGNAME)) Q:DRGNAME="" F S APSPO=$O(^TMP("PSOZCOM1",$J,DRGNAME,APSPO)) Q:APSPO="" D PRINT
  1. Q
  1. S PSOZCOM1("PAGE")=PSOZCOM1("PAGE")+1
  1. I $D(DUZ(2)) W !!,$P(^DIC(4,DUZ(2),0),"^",1)," DISPENSED DRUG LIST"
  1. I '$D(DUZ(2)) W !!,"DISPENSED DRUG LIST"
  1. W ?73,"Page ",PSOZCOM1("PAGE")
  1. W !,"DATE OF LISTING: "
  1. D NOW^%DTC W $E(X,4,5)_"-"_$E(X,6,7)_"-"_$E(X,2,3)
  1. W !!,"This list includes all prescriptions from "
  1. W $E(BD,4,5)_"-"_$E(BD,6,7)_"-"_$E(BD,2,3)," through "
  1. W $E(ED,4,5)_"-"_$E(ED,6,7)_"-"_$E(ED,2,3)_"."
  1. ;W !,"The drug must have been issued a minimum of * "
  1. ;W 9999999-PSZCNT," * times to appear on listing.",!!
  1. W !!,"DRUG",?40,"TOTAL",?47,"NEW",?52,"REFILL",?60,"DISPENSE",?70,"QTY",!,?60,"UNIT"
  1. W ! F I=1:1:IOM W "-"
  1. ;I '$D(^TMP("PSOZCOM2",$J)) W !!?20,"NO RXS FOR A DRUG THAT TOTALS OVER COUNT SPECIFIED" ;G EXIT ;IHS/OHPRD/JCM 11/28/89
  1. W !
  1. Q