- PRCPRPIR ;WISC/RFJ-print picking ticket from tmp global ;06 Sep 91
- V ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- Q
- ;
- ;
- PICK ; come here to print picking ticket from tmp global
- ; tmp($j,"pick",storelocation,nsn,itemda)
- ; =itemda^nsn^storloc^description^onhand^unitiss^qtyordXX^qtytopick
- ; ^invcost^sellcost^costcntr/subacct^accountcode
- N %,%H,%I,ACCT,DATA,DATE,ITEMDA,NSN,NUMBER,PAGE,PRCPFLAG,SCREEN,STORLOC,TOTAL,UNITCOST
- D NOW^%DTC S Y=% D DD^%DT S DATE=Y,TOTAL=0,PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP,STORLOC="",NUMBER=1 U IO D H
- F S STORLOC=$O(^TMP($J,"PRCPRPIR",STORLOC)) Q:STORLOC="" D STORLOC S NSN="" F S NSN=$O(^TMP($J,"PRCPRPIR",STORLOC,NSN)) Q:NSN="" S ITEMDA=0 F S ITEMDA=$O(^TMP($J,"PRCPRPIR",STORLOC,NSN,ITEMDA)) Q:'ITEMDA S DATA=^(ITEMDA) D
- . I $Y>(IOSL-8),$Q(^TMP($J,"PRCPRPIR",STORLOC,NSN,ITEMDA))'="" D:SCREEN P^PRCPUREP S:$D(PRCPFLAG) (STORLOC,NSN,ITEMDA)="zzzzz" Q:$D(PRCPFLAG) D H,STORLOC
- . W !!,$P(DATA,"^",2),?17,$E($P(DATA,"^",4),1,33),?52,"[#",ITEMDA,"]",?63,$J($P(DATA,"^",5),8),?72,"|------|"
- . W !,"-",NUMBER,"-",?12,"ISS MULT UNIT per ISS UNIT COST TOT COST",?60,"QTY TO PICK",?72,"|",?79,"|"
- . S NUMBER=NUMBER+1,UNITCOST=0 I $P(DATA,"^",9) S UNITCOST=$J($P(DATA,"^",11)/$P(DATA,"^",9),0,3)
- . W !?12,$J($P(DATA,"^",7),8),?21,$P(DATA,"^",6),?34,$J(UNITCOST,12,3),$J($P(DATA,"^",11),11,3),?61,$J($P(DATA,"^",9),10)," |______|"
- . W !?12,"CC/SA: ",$P(DATA,"^",12)," ACCT: ",$P(DATA,"^",13)
- . S TOTAL=TOTAL+$P(DATA,"^",11),ACCT(+$P(DATA,"^",13))=$G(ACCT(+$P(DATA,"^",13)))+$P(DATA,"^",10)
- ;
- I '$D(PRCPFLAG),$Y>(IOSL-6) D:SCREEN P^PRCPUREP I '$D(PRCPFLAG) D H
- I $D(PRCPFLAG) D Q Q
- ;
- S (NUMBER,Y)=0 F S NUMBER=$O(^PRCS(410,TRANDA,"IT",NUMBER)) Q:'NUMBER S DATA=$G(^(NUMBER,0)) I +$P(DATA,"^",2)'=+$P(DATA,"^",12) D
- . I Y=0 D H1 S Y=1
- . W !,$$NSN^PRCPUX1(+$P(DATA,"^",5)),?18,"[",+$P(DATA,"^",5),"]",?27,$J(NUMBER,5),$J(+$P(DATA,"^",2),12),$J(+$P(DATA,"^",12),12),?65,$S($P(DATA,"^",14)["S":"SUBSTITUTED",$P(DATA,"^",14)["C":"CANCELLED",1:"")
- . I $Y>(IOSL-4) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H,H1
- I '$D(PRCPFLAG) D END^PRCPRPIQ
- Q D ^%ZISC K ^TMP($J,"PRCPRPIR")
- Q
- ;
- ;
- H S %=DATE_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
- W $C(13),"PICKING TICKET ",$S($D(PRCPFREP):"**REPRINT**",1:"PRINT"),?(80-$L(%)),%
- W !,?10,"FROM: ",PRCP("IN"),?49,"TO: ",$G(PRCPNAME)
- W !?6,"DELIV PT: ",$E($G(DELPT),1,20),?43,"DATE REQ: ",$G(DATEREQ)
- W !,"TRANSACTION NO: ",PRCPTRNO,?38,"REF VOUCHER #: ",PRCPORD,?59,"TRAN ID: ",PRCPTRID,!?3,"DATE POSTED: ",PRCPPOST,?44,"BY USER: ",$E(PRCPUSER,1,17)
- S %="",$P(%,"-",81)="" W !,"NSN",?19,"DESCRIPTION",?52,"[#MI]",?60,"QTY ON-HAND",?74,"PICKED",!,%
- Q
- ;
- ;
- H1 ;header for exceptions
- W !!,"EXCEPTIONS TO ISSUE BOOK REQUEST:",!,"NSN",?18,"[MI#]",?27,$J("LINE#",5),$J("QTY ORDER",12),$J("QTY POSTED",12),?65,"REASON"
- Q
- ;
- ;
- STORLOC W !!?4,"STORAGE LOCATION: ",$S(STORLOC="?":"(NONE)",1:STORLOC) Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPRPIR 3034 printed Feb 18, 2025@23:41:44 Page 2
- PRCPRPIR ;WISC/RFJ-print picking ticket from tmp global ;06 Sep 91
- V ;;5.1;IFCAP;;Oct 20, 2000
- +1 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +2 QUIT
- +3 ;
- +4 ;
- PICK ; come here to print picking ticket from tmp global
- +1 ; tmp($j,"pick",storelocation,nsn,itemda)
- +2 ; =itemda^nsn^storloc^description^onhand^unitiss^qtyordXX^qtytopick
- +3 ; ^invcost^sellcost^costcntr/subacct^accountcode
- +4 NEW %,%H,%I,ACCT,DATA,DATE,ITEMDA,NSN,NUMBER,PAGE,PRCPFLAG,SCREEN,STORLOC,TOTAL,UNITCOST
- +5 DO NOW^%DTC
- SET Y=%
- DO DD^%DT
- SET DATE=Y
- SET TOTAL=0
- SET PAGE=1
- SET SCREEN=$$SCRPAUSE^PRCPUREP
- SET STORLOC=""
- SET NUMBER=1
- USE IO
- DO H
- +6 FOR
- SET STORLOC=$ORDER(^TMP($JOB,"PRCPRPIR",STORLOC))
- if STORLOC=""
- QUIT
- DO STORLOC
- SET NSN=""
- FOR
- SET NSN=$ORDER(^TMP($JOB,"PRCPRPIR",STORLOC,NSN))
- if NSN=""
- QUIT
- SET ITEMDA=0
- FOR
- SET ITEMDA=$ORDER(^TMP($JOB,"PRCPRPIR",STORLOC,NSN,ITEMDA))
- if 'ITEMDA
- QUIT
- SET DATA=^(ITEMDA)
- Begin DoDot:1
- +7 IF $Y>(IOSL-8)
- IF $QUERY(^TMP($JOB,"PRCPRPIR",STORLOC,NSN,ITEMDA))'=""
- if SCREEN
- DO P^PRCPUREP
- if $DATA(PRCPFLAG)
- SET (STORLOC,NSN,ITEMDA)="zzzzz"
- if $DATA(PRCPFLAG)
- QUIT
- DO H
- DO STORLOC
- +8 WRITE !!,$PIECE(DATA,"^",2),?17,$EXTRACT($PIECE(DATA,"^",4),1,33),?52,"[#",ITEMDA,"]",?63,$JUSTIFY($PIECE(DATA,"^",5),8),?72,"|------|"
- +9 WRITE !,"-",NUMBER,"-",?12,"ISS MULT UNIT per ISS UNIT COST TOT COST",?60,"QTY TO PICK",?72,"|",?79,"|"
- +10 SET NUMBER=NUMBER+1
- SET UNITCOST=0
- IF $PIECE(DATA,"^",9)
- SET UNITCOST=$JUSTIFY($PIECE(DATA,"^",11)/$PIECE(DATA,"^",9),0,3)
- +11 WRITE !?12,$JUSTIFY($PIECE(DATA,"^",7),8),?21,$PIECE(DATA,"^",6),?34,$JUSTIFY(UNITCOST,12,3),$JUSTIFY($PIECE(DATA,"^",11),11,3),?61,$JUSTIFY($PIECE(DATA,"^",9),10)," |______|"
- +12 WRITE !?12,"CC/SA: ",$PIECE(DATA,"^",12)," ACCT: ",$PIECE(DATA,"^",13)
- +13 SET TOTAL=TOTAL+$PIECE(DATA,"^",11)
- SET ACCT(+$PIECE(DATA,"^",13))=$GET(ACCT(+$PIECE(DATA,"^",13)))+$PIECE(DATA,"^",10)
- End DoDot:1
- +14 ;
- +15 IF '$DATA(PRCPFLAG)
- IF $Y>(IOSL-6)
- if SCREEN
- DO P^PRCPUREP
- IF '$DATA(PRCPFLAG)
- DO H
- +16 IF $DATA(PRCPFLAG)
- DO Q
- QUIT
- +17 ;
- +18 SET (NUMBER,Y)=0
- FOR
- SET NUMBER=$ORDER(^PRCS(410,TRANDA,"IT",NUMBER))
- if 'NUMBER
- QUIT
- SET DATA=$GET(^(NUMBER,0))
- IF +$PIECE(DATA,"^",2)'=+$PIECE(DATA,"^",12)
- Begin DoDot:1
- +19 IF Y=0
- DO H1
- SET Y=1
- +20 WRITE !,$$NSN^PRCPUX1(+$PIECE(DATA,"^",5)),?18,"[",+$PIECE(DATA,"^",5),"]",?27,$JUSTIFY(NUMBER,5),$JUSTIFY(+$PIECE(DATA,"^",2),12),$JUSTIFY(+$PIECE(DATA,"^",12),12),?65,$SELECT($PIECE(DATA,"^",14)["S":"SUBSTITUTED",...
- ... $PIECE(DATA,"^",14)["C":"CANCELLED",1:"")
- +21 IF $Y>(IOSL-4)
- if SCREEN
- DO P^PRCPUREP
- if $DATA(PRCPFLAG)
- QUIT
- DO H
- DO H1
- End DoDot:1
- +22 IF '$DATA(PRCPFLAG)
- DO END^PRCPRPIQ
- Q DO ^%ZISC
- KILL ^TMP($JOB,"PRCPRPIR")
- +1 QUIT
- +2 ;
- +3 ;
- H SET %=DATE_" PAGE "_PAGE
- SET PAGE=PAGE+1
- IF PAGE'=2!(SCREEN)
- WRITE @IOF
- +1 WRITE $CHAR(13),"PICKING TICKET ",$SELECT($DATA(PRCPFREP):"**REPRINT**",1:"PRINT"),?(80-$LENGTH(%)),%
- +2 WRITE !,?10,"FROM: ",PRCP("IN"),?49,"TO: ",$GET(PRCPNAME)
- +3 WRITE !?6,"DELIV PT: ",$EXTRACT($GET(DELPT),1,20),?43,"DATE REQ: ",$GET(DATEREQ)
- +4 WRITE !,"TRANSACTION NO: ",PRCPTRNO,?38,"REF VOUCHER #: ",PRCPORD,?59,"TRAN ID: ",PRCPTRID,!?3,"DATE POSTED: ",PRCPPOST,?44,"BY USER: ",$EXTRACT(PRCPUSER,1,17)
- +5 SET %=""
- SET $PIECE(%,"-",81)=""
- WRITE !,"NSN",?19,"DESCRIPTION",?52,"[#MI]",?60,"QTY ON-HAND",?74,"PICKED",!,%
- +6 QUIT
- +7 ;
- +8 ;
- H1 ;header for exceptions
- +1 WRITE !!,"EXCEPTIONS TO ISSUE BOOK REQUEST:",!,"NSN",?18,"[MI#]",?27,$JUSTIFY("LINE#",5),$JUSTIFY("QTY ORDER",12),$JUSTIFY("QTY POSTED",12),?65,"REASON"
- +2 QUIT
- +3 ;
- +4 ;
- STORLOC WRITE !!?4,"STORAGE LOCATION: ",$SELECT(STORLOC="?":"(NONE)",1:STORLOC)
- QUIT
