PRCPOPT1 ;WISC/RFJ-picking ticket for distribtuion order ; 4/27/99 9:19am
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
DQ ; queue comes here to print picking ticket
K ^TMP($J,"PRCPOPT"),^TMP($J,"PRCPCRPL-CC"),^TMP($J,"PRCPCRPL-IK")
N %,%I,DATA,INVDATA,ITEMDA,LINE,NOW,NSN,PAGE,PRCPFLAG,REPRINT,SCREEN,STORLOC,TOTAL,UNITCOST,X,Y
;
S ITEMDA=0 F S ITEMDA=$O(^TMP($J,"PRCPOPT PICK LIST",ITEMDA)) Q:'ITEMDA S DATA=$G(^(ITEMDA)) D
. S NSN=$$NSN^PRCPUX1(ITEMDA) S:NSN="" NSN=" " S INVDATA=$G(^PRCP(445,PRCPPRIM,1,ITEMDA,0)),STORLOC=$$STORELOC^PRCPESTO($P(INVDATA,"^",6))
. S:+$P(INVDATA,"^",25)=0 $P(INVDATA,"^",25)=1 S UNITCOST=+$P(DATA,"^",3) S:UNITCOST=0 UNITCOST=+$P(INVDATA,"^",15) S:UNITCOST=0 UNITCOST=+$P(INVDATA,"^",22)
. S %=ITEMDA_"^"_NSN_"^"_STORLOC_"^"_$$DESCR^PRCPUX1(PRCPPRIM,ITEMDA)_"^"_+$P(INVDATA,"^",7)_"^"_$J($$UNITVAL^PRCPUX1($P(INVDATA,"^",14),$P(INVDATA,"^",5)," per "),13)
. S ^TMP($J,"PRCPOPT",STORLOC,NSN,ITEMDA)=%_"^"_$P(INVDATA,"^",25)_"^"_$P(DATA,"^")_"^"_$P(DATA,"^",2)_"^"_UNITCOST_"^"_$J($P(DATA,"^")*UNITCOST,0,3)
. ;
. ; set for cc or ik preparation list
. I $D(^PRCP(445.7,ITEMDA)) S ^TMP($J,"PRCPCRPL-CC",ITEMDA)=""
. I $D(^PRCP(445.8,ITEMDA)) S ^TMP($J,"PRCPCRPL-IK",ITEMDA)=""
;
D NOW^%DTC S Y=% D DD^%DT S NOW=Y,PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP
S:$P(PRCPORD(0),"^",7)="Y" REPRINT=1
I $E(IOST)="P",$D(^PRCP(445.3,ORDERDA,0)) S $P(^(0),"^",7)="Y"
S Y=$P(PRCPORD(0),"^",4) D DD^%DT S $P(PRCPORD(0),"^",4)=Y
S $P(PRCPORD(0),"^",8)=$P($$TYPE^PRCPOPU(ORDERDA),"ORDER")
S $P(PRCPORD(0),"^",6)=$$STATUS^PRCPOPU(ORDERDA)
; check for order already posted
I '$D(^PRCP(445.3,ORDERDA,0)) S $P(PRCPORD(0),"^",6)="POSTED"
;
S TOTAL=0,STORLOC="" U IO D H
F S STORLOC=$O(^TMP($J,"PRCPOPT",STORLOC)) Q:STORLOC=""!($G(PRCPFLAG)) D STORLOC D
. S NSN="" F S NSN=$O(^TMP($J,"PRCPOPT",STORLOC,NSN)) Q:NSN=""!($G(PRCPFLAG)) S ITEMDA=0 F S ITEMDA=$O(^TMP($J,"PRCPOPT",STORLOC,NSN,ITEMDA)) Q:'ITEMDA!($G(PRCPFLAG)) S DATA=^(ITEMDA) D
. . I $Y>(IOSL-7),$Q(^TMP($J,"PRCPOPT",STORLOC,NSN,ITEMDA))'="" D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG) D H,STORLOC
. . W !!,$P(DATA,"^",2),?17,$E($P(DATA,"^",4),1,33),?52,"[#",ITEMDA,"]"
. . W:$E($P(PRCPORD(0),"^",6))'="P" ?63,$J($P(DATA,"^",5),8)
. . W ?72,"|------|"
. . W !?4,"ISS MULT QTY ORD UNIT per ISS UNIT COST TOT COST",?60,"QTY TO PICK",?72,"|",?79,"|"
. . W !?4,$J($P(DATA,"^",7),8) W:$P(DATA,"^",8)#$P(DATA,"^",7)'=0 "*" W ?14,$J($P(DATA,"^",8),7),$P(DATA,"^",6),?34,$J($P(DATA,"^",10),12,3),$J($P(DATA,"^",11),11,3),?61,$J($P(DATA,"^",8),10)," |______|"
. . S TOTAL=TOTAL+$P(DATA,"^",11)
I '$G(PRCPFLAG) D
. K DATA
. S LINE=1
. S X=$G(^PRCP(445.3,ORDERDA,8)) I X'="" S DATA(1)="REMARKS: "_$E(X,1,70),LINE=2 I $E(X,71)'="" S DATA(2)=" "_$E(X,71,140),LINE=3 I $E(X,141)'="" S DATA(3)=" "_$E(X,141,240),LINE=3
. I LINE'=1 S DATA(LINE)=" ",LINE=LINE+1
. F %=1:1 S DATA=$P($T(DATA+%),";",3,99) Q:DATA="" S DATA(LINE)=DATA,LINE=LINE+1
. I $Y>(IOSL-%-4) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG) D H
. W !!,"TOTAL DOLLAR AMOUNT OF ORDER: ",$J(TOTAL,0,3)
. W ! S %=0 F S %=$O(DATA(%)) Q:'% W !,DATA(%)
;
I '$G(PRCPFLAG) I $D(^TMP($J,"PRCPCRPL-CC"))!($D(^TMP($J,"PRCPCRPL-IK"))) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG) D DQ^PRCPCRPL
;
I '$G(PRCPFLAG) D END^PRCPUREP
Q
;
;
H S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
W $C(13),"PICKING TICKET ",$S($D(REPRINT):"RE-",1:""),"PRINT",?(80-$L(%)),%
W !,?4,"FROM: ",$P(PRCPORD(0),"^",2),?39,"TO: ",$P(PRCPORD(0),"^",3)
W !,"ORDER NO: ",$P(PRCPORD(0),"^"),?19,"DATE: ",$P($P(PRCPORD(0),"^",4),"@"),?37,"TYPE: ",$P(PRCPORD(0),"^",8),?54,"STATUS: ",$E($P(PRCPORD(0),"^",6),1,17)
S %="",$P(%,"-",81)="" W !,"NSN",?17,"DESCRIPTION",?52,"[#MI]"
I $E($P(PRCPORD(0),"^",6))'="P" W ?61,"QTY ON-HND"
W ?74,"PICKED",!,% Q
;
;
STORLOC W !!?4,"STORAGE LOCATION: ",$S(STORLOC="?":"(NONE)",1:STORLOC) Q
Q
;
;
DATA ;;print signature at bottom of report
;;SIGNATURE:_________________________ PULLED BY:_______________
;; TITLE:_________________________ VERIFIED BY:_______________
;; DATE:_________________________ DATE TO DELIVER ON:_______________
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPOPT1 4370 printed Sep 23, 2025@19:50:26 Page 2
PRCPOPT1 ;WISC/RFJ-picking ticket for distribtuion order ; 4/27/99 9:19am
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
DQ ; queue comes here to print picking ticket
+1 KILL ^TMP($JOB,"PRCPOPT"),^TMP($JOB,"PRCPCRPL-CC"),^TMP($JOB,"PRCPCRPL-IK")
+2 NEW %,%I,DATA,INVDATA,ITEMDA,LINE,NOW,NSN,PAGE,PRCPFLAG,REPRINT,SCREEN,STORLOC,TOTAL,UNITCOST,X,Y
+3 ;
+4 SET ITEMDA=0
FOR
SET ITEMDA=$ORDER(^TMP($JOB,"PRCPOPT PICK LIST",ITEMDA))
if 'ITEMDA
QUIT
SET DATA=$GET(^(ITEMDA))
Begin DoDot:1
+5 SET NSN=$$NSN^PRCPUX1(ITEMDA)
if NSN=""
SET NSN=" "
SET INVDATA=$GET(^PRCP(445,PRCPPRIM,1,ITEMDA,0))
SET STORLOC=$$STORELOC^PRCPESTO($PIECE(INVDATA,"^",6))
+6 if +$PIECE(INVDATA,"^",25)=0
SET $PIECE(INVDATA,"^",25)=1
SET UNITCOST=+$PIECE(DATA,"^",3)
if UNITCOST=0
SET UNITCOST=+$PIECE(INVDATA,"^",15)
if UNITCOST=0
SET UNITCOST=+$PIECE(INVDATA,"^",22)
+7 SET %=ITEMDA_"^"_NSN_"^"_STORLOC_"^"_$$DESCR^PRCPUX1(PRCPPRIM,ITEMDA)_"^"_+$PIECE(INVDATA,"^",7)_"^"_$JUSTIFY($$UNITVAL^PRCPUX1($PIECE(INVDATA,"^",14),$PIECE(INVDATA,"^",5)," per "),13)
+8 SET ^TMP($JOB,"PRCPOPT",STORLOC,NSN,ITEMDA)=%_"^"_$PIECE(INVDATA,"^",25)_"^"_$PIECE(DATA,"^")_"^"_$PIECE(DATA,"^",2)_"^"_UNITCOST_"^"_$JUSTIFY($PIECE(DATA,"^")*UNITCOST,0,3)
+9 ;
+10 ; set for cc or ik preparation list
+11 IF $DATA(^PRCP(445.7,ITEMDA))
SET ^TMP($JOB,"PRCPCRPL-CC",ITEMDA)=""
+12 IF $DATA(^PRCP(445.8,ITEMDA))
SET ^TMP($JOB,"PRCPCRPL-IK",ITEMDA)=""
End DoDot:1
+13 ;
+14 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET NOW=Y
SET PAGE=1
SET SCREEN=$$SCRPAUSE^PRCPUREP
+15 if $PIECE(PRCPORD(0),"^",7)="Y"
SET REPRINT=1
+16 IF $EXTRACT(IOST)="P"
IF $DATA(^PRCP(445.3,ORDERDA,0))
SET $PIECE(^(0),"^",7)="Y"
+17 SET Y=$PIECE(PRCPORD(0),"^",4)
DO DD^%DT
SET $PIECE(PRCPORD(0),"^",4)=Y
+18 SET $PIECE(PRCPORD(0),"^",8)=$PIECE($$TYPE^PRCPOPU(ORDERDA),"ORDER")
+19 SET $PIECE(PRCPORD(0),"^",6)=$$STATUS^PRCPOPU(ORDERDA)
+20 ; check for order already posted
+21 IF '$DATA(^PRCP(445.3,ORDERDA,0))
SET $PIECE(PRCPORD(0),"^",6)="POSTED"
+22 ;
+23 SET TOTAL=0
SET STORLOC=""
USE IO
DO H
+24 FOR
SET STORLOC=$ORDER(^TMP($JOB,"PRCPOPT",STORLOC))
if STORLOC=""!($GET(PRCPFLAG))
QUIT
DO STORLOC
Begin DoDot:1
+25 SET NSN=""
FOR
SET NSN=$ORDER(^TMP($JOB,"PRCPOPT",STORLOC,NSN))
if NSN=""!($GET(PRCPFLAG))
QUIT
SET ITEMDA=0
FOR
SET ITEMDA=$ORDER(^TMP($JOB,"PRCPOPT",STORLOC,NSN,ITEMDA))
if 'ITEMDA!($GET(PRCPFLAG))
QUIT
SET DATA=^(ITEMDA)
Begin DoDot:2
+26 IF $Y>(IOSL-7)
IF $QUERY(^TMP($JOB,"PRCPOPT",STORLOC,NSN,ITEMDA))'=""
if SCREEN
DO P^PRCPUREP
if $GET(PRCPFLAG)
QUIT
DO H
DO STORLOC
+27 WRITE !!,$PIECE(DATA,"^",2),?17,$EXTRACT($PIECE(DATA,"^",4),1,33),?52,"[#",ITEMDA,"]"
+28 if $EXTRACT($PIECE(PRCPORD(0),"^",6))'="P"
WRITE ?63,$JUSTIFY($PIECE(DATA,"^",5),8)
+29 WRITE ?72,"|------|"
+30 WRITE !?4,"ISS MULT QTY ORD UNIT per ISS UNIT COST TOT COST",?60,"QTY TO PICK",?72,"|",?79,"|"
+31 WRITE !?4,$JUSTIFY($PIECE(DATA,"^",7),8)
if $PIECE(DATA,"^",8)#$PIECE(DATA,"^",7)'=0
WRITE "*"
WRITE ?14,$JUSTIFY($PIECE(DATA,"^",8),7),$PIECE(DATA,"^",6),?34,$JUSTIFY($PIECE(DATA,"^",10),12,3),$JUSTIFY($PIECE(DATA,"^",11),11,3),?61,$JUSTIFY($PIECE(DATA,"^",8),10)," |______|"
+32 SET TOTAL=TOTAL+$PIECE(DATA,"^",11)
End DoDot:2
End DoDot:1
+33 IF '$GET(PRCPFLAG)
Begin DoDot:1
+34 KILL DATA
+35 SET LINE=1
+36 SET X=$GET(^PRCP(445.3,ORDERDA,8))
IF X'=""
SET DATA(1)="REMARKS: "_$EXTRACT(X,1,70)
SET LINE=2
IF $EXTRACT(X,71)'=""
SET DATA(2)=" "_$EXTRACT(X,71,140)
SET LINE=3
IF $EXTRACT(X,141)'=""
SET DATA(3)=" "_$EXTRACT(X,141,240)
SET LINE=3
+37 IF LINE'=1
SET DATA(LINE)=" "
SET LINE=LINE+1
+38 FOR %=1:1
SET DATA=$PIECE($TEXT(DATA+%),";",3,99)
if DATA=""
QUIT
SET DATA(LINE)=DATA
SET LINE=LINE+1
+39 IF $Y>(IOSL-%-4)
if SCREEN
DO P^PRCPUREP
if $GET(PRCPFLAG)
QUIT
DO H
+40 WRITE !!,"TOTAL DOLLAR AMOUNT OF ORDER: ",$JUSTIFY(TOTAL,0,3)
+41 WRITE !
SET %=0
FOR
SET %=$ORDER(DATA(%))
if '%
QUIT
WRITE !,DATA(%)
End DoDot:1
+42 ;
+43 IF '$GET(PRCPFLAG)
IF $DATA(^TMP($JOB,"PRCPCRPL-CC"))!($DATA(^TMP($JOB,"PRCPCRPL-IK")))
if SCREEN
DO P^PRCPUREP
if $GET(PRCPFLAG)
QUIT
DO DQ^PRCPCRPL
+44 ;
+45 IF '$GET(PRCPFLAG)
DO END^PRCPUREP
+46 QUIT
+47 ;
+48 ;
H SET %=NOW_" PAGE "_PAGE
SET PAGE=PAGE+1
IF PAGE'=2!(SCREEN)
WRITE @IOF
+1 WRITE $CHAR(13),"PICKING TICKET ",$SELECT($DATA(REPRINT):"RE-",1:""),"PRINT",?(80-$LENGTH(%)),%
+2 WRITE !,?4,"FROM: ",$PIECE(PRCPORD(0),"^",2),?39,"TO: ",$PIECE(PRCPORD(0),"^",3)
+3 WRITE !,"ORDER NO: ",$PIECE(PRCPORD(0),"^"),?19,"DATE: ",$PIECE($PIECE(PRCPORD(0),"^",4),"@"),?37,"TYPE: ",$PIECE(PRCPORD(0),"^",8),?54,"STATUS: ",$EXTRACT($PIECE(PRCPORD(0),"^",6),1,17)
+4 SET %=""
SET $PIECE(%,"-",81)=""
WRITE !,"NSN",?17,"DESCRIPTION",?52,"[#MI]"
+5 IF $EXTRACT($PIECE(PRCPORD(0),"^",6))'="P"
WRITE ?61,"QTY ON-HND"
+6 WRITE ?74,"PICKED",!,%
QUIT
+7 ;
+8 ;
STORLOC WRITE !!?4,"STORAGE LOCATION: ",$SELECT(STORLOC="?":"(NONE)",1:STORLOC)
QUIT
+1 QUIT
+2 ;
+3 ;
DATA ;;print signature at bottom of report
+1 ;;SIGNATURE:_________________________ PULLED BY:_______________
+2 ;; TITLE:_________________________ VERIFIED BY:_______________
+3 ;; DATE:_________________________ DATE TO DELIVER ON:_______________
