PRCPULAB.m

PRCPULAB ;WISC/RGY-print barcode labels ;4.21.98

 ;;5.1;IFCAP;;Oct 20, 2000

 ;Per VHA Directive 10-93-142, this routine should not be modified.

S W !!,"Do you want to (S)earch/sort inventory items before printing",!,"... or just (P)rint a range of inventory items ? P//" R X:DTIME S:'$T X="^" S:X="" X="P" G:X="^" Q

 I "SP"'[X W $C(7),!!,"Enter an 'S' to search and print or 'P' to print a specific range of items",! G S

 I X="S" D Q G EN^PRCTLAB

 W ! S DIC="^PRCP(445,",DIC(0)="QEAM",PRCPPRIV=1 D ^DIC K PRCPPRIV G:Y<0 Q S PRCPIP=+Y

STA R !,"Start with item #: ",X:DTIME G:"^"[$E(X) Q I X'?.N W !!,"Enter the item number for this inventory point that you want to start",!,"printing from.",! G STA

 S PRCPSTA=X

END R !,"  End with item #: ",X:DTIME G:"^"[$E(X) Q I X'?.N W !!,"Enter the item number for this inventory point that you want to end with.",! G END

 S PRCPEND=X

 I PRCPSTA=PRCPEND,'$D(^PRCP(445,PRCPIP,1,PRCPSTA,0)) W $C(7),!!,"There is not item # "_PRCPSTA_" defined for this inventory point.",! G STA

 I PRCPSTA>PRCPEND W $C(7),!!,"The beginning item number is greater than the ending item number.",! G STA

DEV ;  select device

 S %ZIS("A")="Select BAR CODE PRINTER: ",%ZIS("B")="",%ZIS="Q"

 K IO("Q") D ^%ZIS K %ZIS G:POP Q

 G:'$D(IO("Q")) DQ

 ;  queueing has been requested

 S ZTRTN="DQ^PRCPULAB" F X="PRCPIP","PRCPSTA","PRCPEND","PRCT" S ZTSAVE(X)=""

 S ZTDESC="Bar Code Label Print",ZTIO=ION D ^%ZTLOAD,HOME^%ZIS K PRCT

Q K POP,PRCPSTA,PRCPEND,PRCPIP Q

 ;

DQ ;

 G:$S('$D(PRCT):1,'$D(^PRCT(446.5,PRCT,0)):1,'$D(^PRCT(446.6,+$P(^(0),"^",6),0)):1,1:0) Q1 S PRCT=$P(^PRCT(446.5,PRCT,0),"^",6) F X=0:0 S X=$O(^PRCT(446.6,PRCT,1,X)) Q:'X  W @^(X,0)

 F PRCPSTA=PRCPSTA-1:0 S PRCPSTA=$O(^PRCP(445,PRCPIP,1,PRCPSTA)) Q:PRCPSTA>PRCPEND!'PRCPSTA  D PRNT

Q1 K PRCPSTA,PRCPEND,PRCPIP,PRCT Q

PRNT ;

 F X=0:0 S X=$O(^PRCT(446.6,PRCT,2,X)) Q:'X  W @(^(X,0))

 S X=$$DESCR^PRCPUX1(PRCPIP,PRCPSTA) S:X="" X="NO DESCRIPTION" W $E(X,1,30),!," ",!,"IE",PRCPIP," ",PRCPSTA

 F X=0:0 S X=$O(^PRCT(446.6,PRCT,3,X)) Q:'X  W @(^(X,0))

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCPULAB   2058     printed  Apr 09, 2024@21:07:34                                                                                                                                                                                                    Page 2

PRCPULAB  ;WISC/RGY-print barcode labels ;4.21.98

 +1       ;;5.1;IFCAP;;Oct 20, 2000

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

S          WRITE !!,"Do you want to (S)earch/sort inventory items before printing",!,"... or just (P)rint a range of inventory items ? P//"

           READ X:DTIME

           if '$TEST

               SET X="^"

           if X=""

               SET X="P"

           if X="^"

               GOTO Q

 +1        IF "SP"'[X

               WRITE $CHAR(7),!!,"Enter an 'S' to search and print or 'P' to print a specific range of items",!

               GOTO S

 +2        IF X="S"

               DO Q

               GOTO EN^PRCTLAB

 +3        WRITE !

           SET DIC="^PRCP(445,"

           SET DIC(0)="QEAM"

           SET PRCPPRIV=1

           DO ^DIC

           KILL PRCPPRIV

           if Y<0

               GOTO Q

           SET PRCPIP=+Y

STA        READ !,"Start with item #: ",X:DTIME

           if "^"[$EXTRACT(X)

               GOTO Q

           IF X'?.N

               WRITE !!,"Enter the item number for this inventory point that you want to start",!,"printing from.",!

               GOTO STA

 +1        SET PRCPSTA=X

END        READ !,"  End with item #: ",X:DTIME

           if "^"[$EXTRACT(X)

               GOTO Q

           IF X'?.N

               WRITE !!,"Enter the item number for this inventory point that you want to end with.",!

               GOTO END

 +1        SET PRCPEND=X

 +2        IF PRCPSTA=PRCPEND

               IF '$DATA(^PRCP(445,PRCPIP,1,PRCPSTA,0))

                   WRITE $CHAR(7),!!,"There is not item # "_PRCPSTA_" defined for this inventory point.",!

                   GOTO STA

 +3        IF PRCPSTA>PRCPEND

               WRITE $CHAR(7),!!,"The beginning item number is greater than the ending item number.",!

               GOTO STA

DEV       ;  select device

 +1        SET %ZIS("A")="Select BAR CODE PRINTER: "

           SET %ZIS("B")=""

           SET %ZIS="Q"

 +2        KILL IO("Q")

           DO ^%ZIS

           KILL %ZIS

           if POP

               GOTO Q

 +3        if '$DATA(IO("Q"))

               GOTO DQ

 +4       ;  queueing has been requested

 +5        SET ZTRTN="DQ^PRCPULAB"

           FOR X="PRCPIP","PRCPSTA","PRCPEND","PRCT"

               SET ZTSAVE(X)=""

 +6        SET ZTDESC="Bar Code Label Print"

           SET ZTIO=ION

           DO ^%ZTLOAD

           DO HOME^%ZIS

           KILL PRCT

Q          KILL POP,PRCPSTA,PRCPEND,PRCPIP

           QUIT 

 +1       ;

DQ        ;

 +1        if $SELECT('$DATA(PRCT)

               GOTO Q1

           SET PRCT=$PIECE(^PRCT(446.5,PRCT,0),"^",6)

           FOR X=0:0

               SET X=$ORDER(^PRCT(446.6,PRCT,1,X))

               if 'X

                   QUIT 

               WRITE @^(X,0)

 +2        FOR PRCPSTA=PRCPSTA-1:0

               SET PRCPSTA=$ORDER(^PRCP(445,PRCPIP,1,PRCPSTA))

               if PRCPSTA>PRCPEND!'PRCPSTA

                   QUIT 

               DO PRNT

Q1         KILL PRCPSTA,PRCPEND,PRCPIP,PRCT

           QUIT 

PRNT      ;

 +1        FOR X=0:0

               SET X=$ORDER(^PRCT(446.6,PRCT,2,X))

               if 'X

                   QUIT 

               WRITE @(^(X,0))

 +2        SET X=$$DESCR^PRCPUX1(PRCPIP,PRCPSTA)

           if X=""

               SET X="NO DESCRIPTION"

           WRITE $EXTRACT(X,1,30),!," ",!,"IE",PRCPIP," ",PRCPSTA

 +3        FOR X=0:0

               SET X=$ORDER(^PRCT(446.6,PRCT,3,X))

               if 'X

                   QUIT 

               WRITE @(^(X,0))

 +4        QUIT