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

APSPRT3.m

Go to the documentation of this file.
  1. APSPRT3 ; IHS/DSD/ENM - PRINT UNIT DOSE LABELS ; [ 05/14/1998 4:04 PM ]
  1. ;;6.0;IHS PHARMACY MODIFICATIONS;**1**;09/03/97
  1. START ;
  1. S IOP=APSPRT("IO") D ^%ZIS U IO
  1. D PRINT ;--> Prints labels
  1. D EOJ ; End of job
  1. Q
  1. ;
  1. PRINT S APSP("COPIES")=APSP("COPIES")-1 F I=1:1:APSP(24) W !
  1. W !,?APSP(27),APSP("DRUG") I APSP(29)="Y" W ?APSP(31),APSP("DRUG") ;IHS/DSD/ENM/POC 05/13/98 y replaced w Y
  1. W !,?APSP(27),APSP("CNTL#")," ",APSPRT("EXPDATE")
  1. I APSP(29)="Y" W ?APSP(31),APSP("CNTL#")," ",APSPRT("EXPDATE")
  1. W ! ;IHS/DSD/ENM/POC y replaced w Y
  1. I +APSP("QTY")>1 W ?APSP(27),APSP("QTY") W:APSP(29)="Y" ?APSP(31),APSP("QTY") ;IHS/DSD/ENM/POC 05/13/98 y replaced w Y
  1. F I=1:1:APSP(25) W !
  1. I APSP("COPIES")>0 G PRINT
  1. F I=1:1:(APSP(24)+APSP(25)*APSP(26)) W !
  1. Q
  1. EOJ ;
  1. D ^%ZISC
  1. K APSP("DRUG"),APSPRT("EXPDATE"),APSP("COPIES"),APSP("CNTL#")
  1. K I,IOP
  1. Q