PRCPBAL3 ;WISC/RFJ/DWA-release,print the pick ticket for barcode orders ;04 Dec 92
;;5.1;IFCAP;**47**;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
RELEASE ; release orders in ^tmp($j,"prcpbal3",orderda)
N ITEMDA,ORDERDA,PRCPFLAG,PRCPORD,PRCPPAT,PRCPPRIM,PRCPSECO
S ORDERDA=0 F S ORDERDA=$O(^TMP($J,"PRCPBAL3",ORDERDA)) Q:'ORDERDA D
. L +^PRCP(445.3,ORDERDA):2 Q:'$T
. D VARIABLE^PRCPOPU
. I PRCPORD(0)="" L -^PRCP(445.3,ORDERDA) Q
. W !,"Order # ",$P(PRCPORD(0),"^")
. I $P(PRCPORD(0),"^",6)'="" W ?20,"Already released" L -^PRCP(445.3,ORDERDA) Q
. ; check for items
. 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
. I PRCPFLAG W ?20,"NOT RELEASED, errors found with ordered items." K ^TMP($J,"PRCPBAL3",ORDERDA) L -^PRCP(445.3,ORDERDA) Q
. D RELEASE^PRCPOPR(ORDERDA)
. L -^PRCP(445.3,ORDERDA)
. W ?20,"Released !"
Q
;
;
PICKTICK ; print picking tickets in ^tmp($j,"prcpbal3",orderda)
;
DEVICE ;
K X S X(1)="Enter the DEVICE which will be used to print the picking tickets." D DISPLAY^PRCPUX2(2,40,.X)
W ! S %ZIS="Q" D ^%ZIS Q:POP
I IO=IO(0) W !,"YOU CANNOT SELECT YOUR CURRENT DEVICE FOR PRINTING PICKING TICKETS." G DEVICE
I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q
. S ZTDESC="Print Picking Tickets",ZTRTN="DQ^PRCPBAL3"
. S ZTSAVE("^TMP($J,""PRCPBAL3"",")="",ZTSAVE("ZTREQ")="@"
;
DQ ; print picking tickets for orders in ^tmp($j,"prcpbal3",orderda)
N ORDERDA,PRCPORD,PRCPPAT,PRCPPRIM,PRCPSECO,X
S ORDERDA=0 F S ORDERDA=$O(^TMP($J,"PRCPBAL3",ORDERDA)) Q:'ORDERDA D
. L +^PRCP(445.3,ORDERDA)
. D VARIABLE^PRCPOPU
. I PRCPORD(0)="" L -^PRCP(445.3,ORDERDA) Q
. U IO(0) W !,"Order # ",$P(PRCPORD(0),"^")
. I $P(PRCPORD(0),"^",6)'="R" W ?20,"Not released" L -^PRCP(445.3,ORDERDA) Q
. D BUILD^PRCPOPT(ORDERDA)
. D DQ^PRCPOPT1
. L -^PRCP(445.3,ORDERDA)
. U IO(0) W ?20,"Printed !"
D Q^PRCPOPT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPBAL3 2100 printed Oct 16, 2024@18:13:45 Page 2
PRCPBAL3 ;WISC/RFJ/DWA-release,print the pick ticket for barcode orders ;04 Dec 92
+1 ;;5.1;IFCAP;**47**;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
RELEASE ; release orders in ^tmp($j,"prcpbal3",orderda)
+1 NEW ITEMDA,ORDERDA,PRCPFLAG,PRCPORD,PRCPPAT,PRCPPRIM,PRCPSECO
+2 SET ORDERDA=0
FOR
SET ORDERDA=$ORDER(^TMP($JOB,"PRCPBAL3",ORDERDA))
if 'ORDERDA
QUIT
Begin DoDot:1
+3 LOCK +^PRCP(445.3,ORDERDA):2
if '$TEST
QUIT
+4 DO VARIABLE^PRCPOPU
+5 IF PRCPORD(0)=""
LOCK -^PRCP(445.3,ORDERDA)
QUIT
+6 WRITE !,"Order # ",$PIECE(PRCPORD(0),"^")
+7 IF $PIECE(PRCPORD(0),"^",6)'=""
WRITE ?20,"Already released"
LOCK -^PRCP(445.3,ORDERDA)
QUIT
+8 ; check for items
+9 SET (ITEMDA,PRCPFLAG)=0
FOR
SET ITEMDA=$ORDER(^PRCP(445.3,ORDERDA,1,ITEMDA))
if 'ITEMDA
QUIT
IF $PIECE($GET(^(ITEMDA,0)),"^",2)
IF $$ITEMCHK^PRCPOPER(PRCPPRIM,PRCPSECO,ITEMDA)'=""
SET PRCPFLAG=1
QUIT
+10 IF PRCPFLAG
WRITE ?20,"NOT RELEASED, errors found with ordered items."
KILL ^TMP($JOB,"PRCPBAL3",ORDERDA)
LOCK -^PRCP(445.3,ORDERDA)
QUIT
+11 DO RELEASE^PRCPOPR(ORDERDA)
+12 LOCK -^PRCP(445.3,ORDERDA)
+13 WRITE ?20,"Released !"
End DoDot:1
+14 QUIT
+15 ;
+16 ;
PICKTICK ; print picking tickets in ^tmp($j,"prcpbal3",orderda)
+1 ;
DEVICE ;
+1 KILL X
SET X(1)="Enter the DEVICE which will be used to print the picking tickets."
DO DISPLAY^PRCPUX2(2,40,.X)
+2 WRITE !
SET %ZIS="Q"
DO ^%ZIS
if POP
QUIT
+3 IF IO=IO(0)
WRITE !,"YOU CANNOT SELECT YOUR CURRENT DEVICE FOR PRINTING PICKING TICKETS."
GOTO DEVICE
+4 IF $DATA(IO("Q"))
Begin DoDot:1
+5 SET ZTDESC="Print Picking Tickets"
SET ZTRTN="DQ^PRCPBAL3"
+6 SET ZTSAVE("^TMP($J,""PRCPBAL3"",")=""
SET ZTSAVE("ZTREQ")="@"
End DoDot:1
DO ^%ZTLOAD
KILL IO("Q"),ZTSK
QUIT
+7 ;
DQ ; print picking tickets for orders in ^tmp($j,"prcpbal3",orderda)
+1 NEW ORDERDA,PRCPORD,PRCPPAT,PRCPPRIM,PRCPSECO,X
+2 SET ORDERDA=0
FOR
SET ORDERDA=$ORDER(^TMP($JOB,"PRCPBAL3",ORDERDA))
if 'ORDERDA
QUIT
Begin DoDot:1
+3 LOCK +^PRCP(445.3,ORDERDA)
+4 DO VARIABLE^PRCPOPU
+5 IF PRCPORD(0)=""
LOCK -^PRCP(445.3,ORDERDA)
QUIT
+6 USE IO(0)
WRITE !,"Order # ",$PIECE(PRCPORD(0),"^")
+7 IF $PIECE(PRCPORD(0),"^",6)'="R"
WRITE ?20,"Not released"
LOCK -^PRCP(445.3,ORDERDA)
QUIT
+8 DO BUILD^PRCPOPT(ORDERDA)
+9 DO DQ^PRCPOPT1
+10 LOCK -^PRCP(445.3,ORDERDA)
+11 USE IO(0)
WRITE ?20,"Printed !"
End DoDot:1
+12 DO Q^PRCPOPT
+13 QUIT
