| 1 | PRCPBAL3 ;WISC/RFJ/DWA-release,print the pick ticket for barcode orders ;04 Dec 92 | 
|---|
| 2 | ;;5.1;IFCAP;**47**;Oct 20, 2000 | 
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified. | 
|---|
| 4 | Q | 
|---|
| 5 | ; | 
|---|
| 6 | ; | 
|---|
| 7 | RELEASE ;  release orders in ^tmp($j,"prcpbal3",orderda) | 
|---|
| 8 | N ITEMDA,ORDERDA,PRCPFLAG,PRCPORD,PRCPPAT,PRCPPRIM,PRCPSECO | 
|---|
| 9 | S ORDERDA=0 F  S ORDERDA=$O(^TMP($J,"PRCPBAL3",ORDERDA)) Q:'ORDERDA  D | 
|---|
| 10 | .   L +^PRCP(445.3,ORDERDA):2 Q:'$T | 
|---|
| 11 | .   D VARIABLE^PRCPOPU | 
|---|
| 12 | .   I PRCPORD(0)="" L -^PRCP(445.3,ORDERDA) Q | 
|---|
| 13 | .   W !,"Order # ",$P(PRCPORD(0),"^") | 
|---|
| 14 | .   I $P(PRCPORD(0),"^",6)'="" W ?20,"Already released" L -^PRCP(445.3,ORDERDA) Q | 
|---|
| 15 | .   ;  check for items | 
|---|
| 16 | .   S (ITEMDA,PRCPFLAG)=0 F  S ITEMDA=$O(^PRCP(445.3,ORDERDA,1,ITEMDA)) Q:'ITEMDA  I $P($G(^(ITEMDA,0)),"^",2),$$ITEMCHK^PRCPOPER(PRCPPRIM,PRCPSECO,ITEMDA)'="" S PRCPFLAG=1 Q | 
|---|
| 17 | .   I PRCPFLAG W ?20,"NOT RELEASED, errors found with ordered items." K ^TMP($J,"PRCPBAL3",ORDERDA) L -^PRCP(445.3,ORDERDA) Q | 
|---|
| 18 | .   D RELEASE^PRCPOPR(ORDERDA) | 
|---|
| 19 | .   L -^PRCP(445.3,ORDERDA) | 
|---|
| 20 | .   W ?20,"Released !" | 
|---|
| 21 | Q | 
|---|
| 22 | ; | 
|---|
| 23 | ; | 
|---|
| 24 | PICKTICK ;  print picking tickets in ^tmp($j,"prcpbal3",orderda) | 
|---|
| 25 | ; | 
|---|
| 26 | DEVICE ; | 
|---|
| 27 | K X S X(1)="Enter the DEVICE which will be used to print the picking tickets." D DISPLAY^PRCPUX2(2,40,.X) | 
|---|
| 28 | W ! S %ZIS="Q" D ^%ZIS Q:POP | 
|---|
| 29 | I IO=IO(0) W !,"YOU CANNOT SELECT YOUR CURRENT DEVICE FOR PRINTING PICKING TICKETS." G DEVICE | 
|---|
| 30 | I $D(IO("Q")) D  D ^%ZTLOAD K IO("Q"),ZTSK Q | 
|---|
| 31 | .   S ZTDESC="Print Picking Tickets",ZTRTN="DQ^PRCPBAL3" | 
|---|
| 32 | .   S ZTSAVE("^TMP($J,""PRCPBAL3"",")="",ZTSAVE("ZTREQ")="@" | 
|---|
| 33 | ; | 
|---|
| 34 | DQ ;  print picking tickets for orders in ^tmp($j,"prcpbal3",orderda) | 
|---|
| 35 | N ORDERDA,PRCPORD,PRCPPAT,PRCPPRIM,PRCPSECO,X | 
|---|
| 36 | S ORDERDA=0 F  S ORDERDA=$O(^TMP($J,"PRCPBAL3",ORDERDA)) Q:'ORDERDA  D | 
|---|
| 37 | .   L +^PRCP(445.3,ORDERDA) | 
|---|
| 38 | .   D VARIABLE^PRCPOPU | 
|---|
| 39 | .   I PRCPORD(0)="" L -^PRCP(445.3,ORDERDA) Q | 
|---|
| 40 | .   U IO(0) W !,"Order # ",$P(PRCPORD(0),"^") | 
|---|
| 41 | .   I $P(PRCPORD(0),"^",6)'="R" W ?20,"Not released" L -^PRCP(445.3,ORDERDA) Q | 
|---|
| 42 | .   D BUILD^PRCPOPT(ORDERDA) | 
|---|
| 43 | .   D DQ^PRCPOPT1 | 
|---|
| 44 | .   L -^PRCP(445.3,ORDERDA) | 
|---|
| 45 | .   U IO(0) W ?20,"Printed !" | 
|---|
| 46 | D Q^PRCPOPT | 
|---|
| 47 | Q | 
|---|