| [613] | 1 | PRCPAUTH ;WISC/AKS,DWA-receive purchase order (list manager) ;6/8/96 13:09
|
|---|
| 2 | ;;5.1;IFCAP;**22**;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | INV D ^PRCPUSEL Q:'$G(PRCP("I"))
|
|---|
| 5 | I "PW"'[PRCP("DPTYPE") W !,"YOU MUST BE A WAREHOUSE OR PRIMARY INVENTORY POINT TO RECEIVE THIS PO IN THE INVENTORY." S NOINV=1 Q
|
|---|
| 6 | I $$CHECK^PRCPCUT1(PRCP("I")) W !,"CAN NOT RECEIVE THIS PO IN THE INVENTORY" S NOINV=1 Q
|
|---|
| 7 | N %,PRCPFCOS,PRCPINPT,PRCPORDN,PRCPORDR,PRCPPARD,PRCPPART,PRCPTYPE,PRCPVEND,PRCPVENN,X,Y
|
|---|
| 8 | S PRCPINPT=PRCP("I"),PRCPTYPE=PRCP("DPTYPE")
|
|---|
| 9 | I '$D(^PRC(442,"G",PRCPINPT,PRCHPO)) S NOINV=1 Q
|
|---|
| 10 | S PRCPVEND=+$G(^PRC(442,PRCHPO,1)),PRCPVENN=$P($G(^PRC(440,PRCPVEND,0)),"^")
|
|---|
| 11 | I PRCPVEND="" W !,"ERROR - INVALID OR MISSING VENDOR ON THIS PURCHASE ORDER !",!,"CAN NOT RECEIVE THIS PO IN THE INVENTORY" S NOINV=1 Q
|
|---|
| 12 | S PRCPORDR=PRCHPO
|
|---|
| 13 | REBUILD ; called here to rebuild array
|
|---|
| 14 | K PRCPDATA
|
|---|
| 15 | S (PRCPFLAG,PRCHFLAG,PRCPFCOS)=0
|
|---|
| 16 | N RCHK,%,AVGCOST,CONV,INVDATA,ITEMDA,LINE,LINEDA,PODATA,POQTY,POUI,QTYRECVE,TOTCOST,TRANDA,TRANDATA,TRUI,UNITCOST,X
|
|---|
| 17 | S TRANDA=+$P(^PRC(442,PRCPORDR,0),"^",12)
|
|---|
| 18 | S LINE=0
|
|---|
| 19 | S LINEDA=0 F S LINEDA=$O(^PRC(442,PRCPORDR,2,LINEDA)) Q:'LINEDA S PODATA=$G(^(LINEDA,0)) I PODATA'="" D
|
|---|
| 20 | . S ITEMDA=+$P(PODATA,"^",5) I 'ITEMDA,$P(PODATA,"^",13)'="" S ITEMDA=+$O(^PRC(441,"BB",$P(PODATA,"^",13),0))
|
|---|
| 21 | . S (PRCPFLAG,RCHK)=""
|
|---|
| 22 | . ;
|
|---|
| 23 | . ; get outstanding transaction data
|
|---|
| 24 | . I 'TRANDA S TRANDA=+$P(PODATA,"^",10)
|
|---|
| 25 | . Q:'$D(^PRCP(445,PRCPINPT,1,ITEMDA,0))
|
|---|
| 26 | . I +$P($G(^PRC(442,PRCPORDR,2,LINEDA,2)),U,8)<$P($G(^PRC(442,PRCPORDR,2,LINEDA,0)),U,2) S RCHK=1
|
|---|
| 27 | . S TRANDATA=$G(^PRCP(445,PRCPINPT,1,ITEMDA,7,TRANDA,0)),TRUI=$$UNITVAL^PRCPUX1($P(TRANDATA,"^",4),$P(TRANDATA,"^",3),"/"),CONV=$P(TRANDATA,"^",5)
|
|---|
| 28 | . ; if there is not a due-in established, look up conversion factor
|
|---|
| 29 | . ; from procurement source multiple
|
|---|
| 30 | . I 'CONV S CONV=$P($$GETVEN^PRCPUVEN(PRCPINPT,ITEMDA,+$P($G(^PRC(442,PRCPORDR,1)),"^")_";PRC(440,",0),"^",4)
|
|---|
| 31 | . I 'CONV S CONV="?"
|
|---|
| 32 | . ;
|
|---|
| 33 | . I $P($G(^PRCS(410,TRANDA,0)),"^",6)'=PRCPINPT S PRCPFLAG=1 W !,"ERROR: INVENTORY POINT NOT TIED TO 2237 "_$P($G(^PRCS(410,TRANDA,0)),"^")
|
|---|
| 34 | . I TRANDATA="",RCHK=1 S PRCPFLAG=1 W !,"ERROR: 2237 "_$P($G(^PRCS(410,TRANDA,0)),"^")_" NOT ESTABLISHED AS A DUE-IN"
|
|---|
| 35 | . S POUI=$$UNITVAL^PRCPUX1($P(PODATA,"^",12),$P(PODATA,"^",3),"/")
|
|---|
| 36 | . I TRANDATA'="",POUI'=TRUI S PRCPFLAG=1 W !,"ERROR: PO U/I "_POUI_" DOES NOT EQUAL DUE-IN U/R "_TRUI
|
|---|
| 37 | . I $D(^PRCP(445,PRCPINPT,1,ITEMDA,0)),'CONV S PRCPFLAG=1 W !,"ERROR: NO CONVERSION FACTOR. EDIT THE DUE-IN OR VENDOR TO SET THE CF"
|
|---|
| 38 | . I PRCPFLAG W !,"FIX ERRORS BEFORE RECEIVING" S PRCHFLAG=1 K PRCPFLAG
|
|---|
| 39 | QUIT
|
|---|
