source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPOPT.m@ 1780

Last change on this file since 1780 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.1 KB
Line 
1PRCPOPT ;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 ;
7PICKLM ; 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 ;
20DQ ; queue comes here to print picking ticket
21 D DQ^PRCPOPT1
22Q ; 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 ;
28BUILD(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
Note: See TracBrowser for help on using the repository browser.