| 1 | PRCPOPT ;WISC/RFJ-picking ticket for distribution order            ;27 Sep 93
 | 
|---|
| 2 |  ;;5.1;IFCAP;;Oct 20, 2000
 | 
|---|
| 3 |  ;Per VHA Directive 10-93-142, this routine should not be modified.
 | 
|---|
| 4 |  Q
 | 
|---|
| 5 |  ;
 | 
|---|
| 6 |  ;
 | 
|---|
| 7 | PICKLM ;  called from list manager to print picking ticket
 | 
|---|
| 8 |  S VALMBCK="R"
 | 
|---|
| 9 |  D FULL^VALM1
 | 
|---|
| 10 |  D BUILD(ORDERDA)
 | 
|---|
| 11 |  D VARIABLE^PRCPOPU
 | 
|---|
| 12 |  S %ZIS="Q" D ^%ZIS I POP D Q Q
 | 
|---|
| 13 |  I $D(IO("Q")) D  Q
 | 
|---|
| 14 |  .   S ZTDESC="Print Picking Ticket (Primary to Secondary)",ZTRTN="DQ^PRCPOPT"
 | 
|---|
| 15 |  .   S ZTSAVE("PRCP*")="",ZTSAVE("ORDERDA")="",ZTSAVE("^TMP($J,""PRCPOPT PICK LIST"",")="",ZTSAVE("ZTREQ")="@"
 | 
|---|
| 16 |  .   D ^%ZTLOAD K IO("Q"),ZTSK
 | 
|---|
| 17 |  .   S:$D(^PRCP(445.3,ORDERDA,0)) $P(^(0),"^",7)="Y"
 | 
|---|
| 18 |  .   D Q
 | 
|---|
| 19 |  ;
 | 
|---|
| 20 | DQ ;  queue comes here to print picking ticket
 | 
|---|
| 21 |  D DQ^PRCPOPT1
 | 
|---|
| 22 | Q ;  clean up
 | 
|---|
| 23 |  D ^%ZISC
 | 
|---|
| 24 |  K ^TMP($J,"PRCPOPT"),^TMP($J,"PRCPOPT PICK LIST"),^TMP($J,"PRCPCRPL-CC"),^TMP($J,"PRCPCRPL-IK")
 | 
|---|
| 25 |  Q
 | 
|---|
| 26 |  ;
 | 
|---|
| 27 |  ;
 | 
|---|
| 28 | BUILD(ORDERDA) ;  build order in tmp for printing the picking ticket
 | 
|---|
| 29 |  N DATA,ITEMDA
 | 
|---|
| 30 |  K ^TMP($J,"PRCPOPT PICK LIST")
 | 
|---|
| 31 |  S ITEMDA=0 F  S ITEMDA=$O(^PRCP(445.3,ORDERDA,1,ITEMDA)) Q:'ITEMDA  S DATA=$G(^(ITEMDA,0)) I DATA'="" S ^TMP($J,"PRCPOPT PICK LIST",ITEMDA)=$P(DATA,"^",2)_"^"_$P(DATA,"^",4)
 | 
|---|
| 32 |  Q
 | 
|---|