APSPRT3 ; IHS/DSD/ENM - PRINT UNIT DOSE LABELS ; [ 05/14/1998 4:04 PM ]
;;6.0;IHS PHARMACY MODIFICATIONS;**1**;09/03/97
START ;
S IOP=APSPRT("IO") D ^%ZIS U IO
D PRINT ;--> Prints labels
D EOJ ; End of job
Q
;
PRINT S APSP("COPIES")=APSP("COPIES")-1 F I=1:1:APSP(24) W !
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
W !,?APSP(27),APSP("CNTL#")," ",APSPRT("EXPDATE")
I APSP(29)="Y" W ?APSP(31),APSP("CNTL#")," ",APSPRT("EXPDATE")
W ! ;IHS/DSD/ENM/POC y replaced w Y
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
F I=1:1:APSP(25) W !
I APSP("COPIES")>0 G PRINT
F I=1:1:(APSP(24)+APSP(25)*APSP(26)) W !
Q
EOJ ;
D ^%ZISC
K APSP("DRUG"),APSPRT("EXPDATE"),APSP("COPIES"),APSP("CNTL#")
K I,IOP
Q
APSPRT3 ; IHS/DSD/ENM - PRINT UNIT DOSE LABELS ; [ 05/14/1998 4:04 PM ]
+1 ;;6.0;IHS PHARMACY MODIFICATIONS;**1**;09/03/97
START ;
+1 SET IOP=APSPRT("IO")
DO ^%ZIS
USE IO
+2 ;--> Prints labels
DO PRINT
+3 ; End of job
DO EOJ
+4 QUIT
+5 ;
PRINT SET APSP("COPIES")=APSP("COPIES")-1
FOR I=1:1:APSP(24)
WRITE !
+1 ;IHS/DSD/ENM/POC 05/13/98 y replaced w Y
WRITE !,?APSP(27),APSP("DRUG")
IF APSP(29)="Y"
WRITE ?APSP(31),APSP("DRUG")
+2 WRITE !,?APSP(27),APSP("CNTL#")," ",APSPRT("EXPDATE")
+3 IF APSP(29)="Y"
WRITE ?APSP(31),APSP("CNTL#")," ",APSPRT("EXPDATE")
+4 ;IHS/DSD/ENM/POC y replaced w Y
WRITE !
+5 ;IHS/DSD/ENM/POC 05/13/98 y replaced w Y
IF +APSP("QTY")>1
WRITE ?APSP(27),APSP("QTY")
IF APSP(29)="Y"
WRITE ?APSP(31),APSP("QTY")
+6 FOR I=1:1:APSP(25)
WRITE !
+7 IF APSP("COPIES")>0
GOTO PRINT
+8 FOR I=1:1:(APSP(24)+APSP(25)*APSP(26))
WRITE !
+9 QUIT
EOJ ;
+1 DO ^%ZISC
+2 KILL APSP("DRUG"),APSPRT("EXPDATE"),APSP("COPIES"),APSP("CNTL#")
+3 KILL I,IOP
+4 QUIT