APSPRT2.m

APSPRT2 ; IHS/DSD/ENM - PRINT PREPACK LABELS ;  [ 09/03/97   1:30 PM ]

 ;;6.0;IHS PHARMACY MODIFICATIONS;;09/03/97

 ;

 D ZIS

 D PRINT

 D EOJ

 Q

 ;

ZIS ;

 S IOP=APSPRT("IO") D ^%ZIS U IO

 Q

 ;

PRINT ;

START S APSP("COPIES")=APSP("COPIES")-1 F I=1:1:APSP(17) W !

 S APSPZZL=4

 S APSPZLA=APSP(16)-APSPZZL

 W !,?APSP(21),$E(APSP("LINE1"),1,APSP(22))

SIG ;

 G CON:APSPZLA<APSPGC F APSPDR=1:1:APSPZLA D SIG1

 G NEXT

CON S (APSPDR,APSPF)=0

C1 F I=1:1:APSP(16)-2 S APSPDR=APSPDR+1 D SIG1 Q:'$D(APSPGY(APSPDR+1))

 I '$D(APSPGY(APSPDR+1))&(I>APSPZLA) F II=1:1:(APSP(16)-2-I) W !

 I '$D(APSPGY(APSPDR+1)) G NEXT:APSPF&(I'>APSPZLA) ;IHS/BAO/JCM 2/3/89

 W !,?APSP(21),"****  CONTINUED  ****" S APSPF=1

 F I=1:1:APSP(18)+APSP(17) W !

 W !,?APSP(21),"****  CONTINUED  ****" S APSPZM=$S(APSPZLA-(APSPGC-APSPDR)'<0:APSPZLA-(APSPGC-APSPDR),1:0) F I=1:1:APSPZM W !

 G C1:APSPDR<APSPGC

NEXT ;

 W !,?APSP(21),APSP("DRUG")

 I '$D(APSP("QTYFLG")) W ?(APSP(21)+APSP(22)-$L(APSP("QTY"))),APSP("QTY")

 W !,?APSP(21),APSP("CNTL#")

 W ?(APSP(21)+APSP(22)-$L(APSPRT("EXPDATE"))),APSPRT("EXPDATE")

 W !,?APSP(21),$E(APSP("LINE2"),1,APSP(22))

 F I=1:1:APSP(18) W !

 I APSP("COPIES")>0 G START

 F I=1:1:(APSP(19)*(APSP(16)+APSP(17)+APSP(18))) W !

 Q

 ;

SIG1 S X=$S($D(APSPGY(APSPDR)):APSPGY(APSPDR),1:"") W !,?APSP(21),X

 Q

 ;

EOJ ;

 D ^%ZISC

 K APSPDR,APSPF,APSPGC,APSPGY,APSPZLA,APSPZM,APSPZZL,I,II,IOP,X

 K APSP("DRUG"),APSPRT("EXPDATE"),APSP("COPIES"),APSP("CNTL#")

 K I,IOP

 Q

APSPRT2   ; IHS/DSD/ENM - PRINT PREPACK LABELS ;  [ 09/03/97   1:30 PM ]

 +1       ;;6.0;IHS PHARMACY MODIFICATIONS;;09/03/97

 +2       ;

 +3        DO ZIS

 +4        DO PRINT

 +5        DO EOJ

 +6        QUIT 

 +7       ;

ZIS       ;

 +1        SET IOP=APSPRT("IO")

           DO ^%ZIS

           USE IO

 +2        QUIT 

 +3       ;

PRINT     ;

START      SET APSP("COPIES")=APSP("COPIES")-1

           FOR I=1:1:APSP(17)

               WRITE !

 +1        SET APSPZZL=4

 +2        SET APSPZLA=APSP(16)-APSPZZL

 +3        WRITE !,?APSP(21),$EXTRACT(APSP("LINE1"),1,APSP(22))

SIG       ;

 +1        IF APSPZLA<APSPGC

               GOTO CON

           FOR APSPDR=1:1:APSPZLA

               DO SIG1

 +2        GOTO NEXT

CON        SET (APSPDR,APSPF)=0

C1         FOR I=1:1:APSP(16)-2

               SET APSPDR=APSPDR+1

               DO SIG1

               IF '$DATA(APSPGY(APSPDR+1))

                   QUIT 

 +1        IF '$DATA(APSPGY(APSPDR+1))&(I>APSPZLA)

               FOR II=1:1:(APSP(16)-2-I)

                   WRITE !

 +2       ;IHS/BAO/JCM 2/3/89

           IF '$DATA(APSPGY(APSPDR+1))

               IF APSPF&(I'>APSPZLA)

                   GOTO NEXT

 +3        WRITE !,?APSP(21),"****  CONTINUED  ****"

           SET APSPF=1

 +4        FOR I=1:1:APSP(18)+APSP(17)

               WRITE !

 +5        WRITE !,?APSP(21),"****  CONTINUED  ****"

           SET APSPZM=$SELECT(APSPZLA-(APSPGC-APSPDR)'<0:APSPZLA-(APSPGC-APSPDR),1:0)

           FOR I=1:1:APSPZM

               WRITE !

 +6        IF APSPDR<APSPGC

               GOTO C1

NEXT      ;

 +1        WRITE !,?APSP(21),APSP("DRUG")

 +2        IF '$DATA(APSP("QTYFLG"))

               WRITE ?(APSP(21)+APSP(22)-$LENGTH(APSP("QTY"))),APSP("QTY")

 +3        WRITE !,?APSP(21),APSP("CNTL#")

 +4        WRITE ?(APSP(21)+APSP(22)-$LENGTH(APSPRT("EXPDATE"))),APSPRT("EXPDATE")

 +5        WRITE !,?APSP(21),$EXTRACT(APSP("LINE2"),1,APSP(22))

 +6        FOR I=1:1:APSP(18)

               WRITE !

 +7        IF APSP("COPIES")>0

               GOTO START

 +8        FOR I=1:1:(APSP(19)*(APSP(16)+APSP(17)+APSP(18)))

               WRITE !

 +9        QUIT 

 +10      ;

SIG1       SET X=$SELECT($DATA(APSPGY(APSPDR)):APSPGY(APSPDR),1:"")

           WRITE !,?APSP(21),X

 +1        QUIT 

 +2       ;

EOJ       ;

 +1        DO ^%ZISC

 +2        KILL APSPDR,APSPF,APSPGC,APSPGY,APSPZLA,APSPZM,APSPZZL,I,II,IOP,X

 +3        KILL APSP("DRUG"),APSPRT("EXPDATE"),APSP("COPIES"),APSP("CNTL#")

 +4        KILL I,IOP

 +5        QUIT