PRCPOPT.m

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 ---PRCPOPT   1164     printed  Apr 23, 2025@18:28:51                                                                                                                                                                                                     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