- 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 Feb 18, 2025@23:40:44 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:_______________