PRCPOPT ;WISC/RFJ-picking ticket for distribution order ;27 Sep 93
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
PICKLM ; called from list manager to print picking ticket
S VALMBCK="R"
D FULL^VALM1
D BUILD(ORDERDA)
D VARIABLE^PRCPOPU
S %ZIS="Q" D ^%ZIS I POP D Q Q
I $D(IO("Q")) D Q
. S ZTDESC="Print Picking Ticket (Primary to Secondary)",ZTRTN="DQ^PRCPOPT"
. S ZTSAVE("PRCP*")="",ZTSAVE("ORDERDA")="",ZTSAVE("^TMP($J,""PRCPOPT PICK LIST"",")="",ZTSAVE("ZTREQ")="@"
. D ^%ZTLOAD K IO("Q"),ZTSK
. S:$D(^PRCP(445.3,ORDERDA,0)) $P(^(0),"^",7)="Y"
. D Q
;
DQ ; queue comes here to print picking ticket
D DQ^PRCPOPT1
Q ; clean up
D ^%ZISC
K ^TMP($J,"PRCPOPT"),^TMP($J,"PRCPOPT PICK LIST"),^TMP($J,"PRCPCRPL-CC"),^TMP($J,"PRCPCRPL-IK")
Q
;
;
BUILD(ORDERDA) ; build order in tmp for printing the picking ticket
N DATA,ITEMDA
K ^TMP($J,"PRCPOPT PICK LIST")
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)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPOPT 1164 printed Nov 22, 2024@17:24:26 Page 2
PRCPOPT ;WISC/RFJ-picking ticket for distribution order ;27 Sep 93
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
PICKLM ; called from list manager to print picking ticket
+1 SET VALMBCK="R"
+2 DO FULL^VALM1
+3 DO BUILD(ORDERDA)
+4 DO VARIABLE^PRCPOPU
+5 SET %ZIS="Q"
DO ^%ZIS
IF POP
DO Q
QUIT
+6 IF $DATA(IO("Q"))
Begin DoDot:1
+7 SET ZTDESC="Print Picking Ticket (Primary to Secondary)"
SET ZTRTN="DQ^PRCPOPT"
+8 SET ZTSAVE("PRCP*")=""
SET ZTSAVE("ORDERDA")=""
SET ZTSAVE("^TMP($J,""PRCPOPT PICK LIST"",")=""
SET ZTSAVE("ZTREQ")="@"
+9 DO ^%ZTLOAD
KILL IO("Q"),ZTSK
+10 if $DATA(^PRCP(445.3,ORDERDA,0))
SET $PIECE(^(0),"^",7)="Y"
+11 DO Q
End DoDot:1
QUIT
+12 ;
DQ ; queue comes here to print picking ticket
+1 DO DQ^PRCPOPT1
Q ; clean up
+1 DO ^%ZISC
+2 KILL ^TMP($JOB,"PRCPOPT"),^TMP($JOB,"PRCPOPT PICK LIST"),^TMP($JOB,"PRCPCRPL-CC"),^TMP($JOB,"PRCPCRPL-IK")
+3 QUIT
+4 ;
+5 ;
BUILD(ORDERDA) ; build order in tmp for printing the picking ticket
+1 NEW DATA,ITEMDA
+2 KILL ^TMP($JOB,"PRCPOPT PICK LIST")
+3 SET ITEMDA=0
FOR
SET ITEMDA=$ORDER(^PRCP(445.3,ORDERDA,1,ITEMDA))
if 'ITEMDA
QUIT
SET DATA=$GET(^(ITEMDA,0))
IF DATA'=""
SET ^TMP($JOB,"PRCPOPT PICK LIST",ITEMDA)=$PIECE(DATA,"^",2)_"^"_$PIECE(DATA,"^",4)
+4 QUIT
