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