Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCPPOLB

PRCPPOLB.m

Go to the documentation of this file.
  1. PRCPPOLB ;WISC/RFJ-receive purchase order (build array) ;06 Jan 94
  1. ;;5.1;IFCAP;;Oct 20, 2000
  1. ;Per VHA Directive 10-93-142, this routine should not be modified.
  1. Q
  1. ;
  1. ;
  1. REBUILD ; called here to rebuild array
  1. K PRCPDATA,^TMP($J,"PRCPPOLM"),^TMP($J,"PRCPPOLMREC")
  1. S (PRCPFLAG,PRCPFCOS)=0
  1. N %,AVGCOST,CONV,INVDATA,ITEMDA,LINE,LINEDA,PODATA,POQTY,POUI,QTYRECVE,TOTCOST,TRANDA,TRANDATA,TRUI,UNITCOST,X
  1. S TRANDA=+$P(^PRC(442,PRCPORDR,0),"^",12)
  1. S LINE=0
  1. S LINEDA=0 F S LINEDA=$O(^PRC(442,PRCPORDR,2,LINEDA)) Q:'LINEDA S PODATA=$G(^(LINEDA,0)) I PODATA'="" D
  1. . S %=$O(^PRC(442,PRCPORDR,2,LINEDA,3,"AC",PRCPPART,0)) Q:'%
  1. . S POQTY=+$P($G(^PRC(442,PRCPORDR,2,LINEDA,3,%,0)),"^",2) I 'POQTY Q
  1. . S ITEMDA=+$P(PODATA,"^",5) I 'ITEMDA,$P(PODATA,"^",13)'="" S ITEMDA=+$O(^PRC(441,"BB",$P(PODATA,"^",13),0))
  1. . S LINE=LINE+1
  1. . D SET(LINEDA,LINE,1,80,IORVON,IORVOFF)
  1. . D SET($$DESCR^PRCPUX1(PRCPINPT,ITEMDA),LINE,6,23)
  1. . D SET($J(+ITEMDA,6),LINE,24,29)
  1. . D SET($J(POQTY,8),LINE,30,37)
  1. . ;
  1. . ; get outstanding transaction data
  1. . I 'TRANDA S TRANDA=+$P(PODATA,"^",10)
  1. . S TRANDATA=$G(^PRCP(445,PRCPINPT,1,ITEMDA,7,TRANDA,0)),TRUI=$$UNITVAL^PRCPUX1($P(TRANDATA,"^",4),$P(TRANDATA,"^",3),"/"),CONV=$P(TRANDATA,"^",5)
  1. . ; if there is not a due-in established, look up conversion factor
  1. . ; from procurement source multiple
  1. . I 'CONV S CONV=$P($$GETVEN^PRCPUVEN(PRCPINPT,ITEMDA,+$P($G(^PRC(442,PRCPORDR,1)),"^")_";PRC(440,",0),"^",4)
  1. . I 'CONV S CONV="?"
  1. . S QTYRECVE=POQTY*$S('CONV:1,1:CONV)
  1. . ;
  1. . ; get costs
  1. . S TOTCOST=$J(POQTY*$P(PODATA,"^",9),0,2),UNITCOST=$J(TOTCOST/QTYRECVE,0,2)
  1. . S INVDATA=$G(^PRCP(445,PRCPINPT,1,ITEMDA,0)),AVGCOST=$P(INVDATA,"^",22)
  1. . D SET($J(CONV,5),LINE,38,42)
  1. . D SET($J(QTYRECVE,8),LINE,43,50)
  1. . D SET($J(AVGCOST,10,2),LINE,51,60)
  1. . D SET($J(UNITCOST,10,2),LINE,61,70)
  1. . D SET($J(TOTCOST,10,2),LINE,71,80)
  1. . ;
  1. . ; cost to distribution point
  1. . I '$D(^PRCP(445,PRCPINPT,1,ITEMDA,0)) D
  1. . . S X=$G(^TMP($J,"PRCPPOLMCOS",LINEDA))
  1. . . I X="" S ^TMP($J,"PRCPPOLMCOS",LINEDA)=ITEMDA
  1. . . S %=$$INVNAME^PRCPUX1($P(X,"^",2))
  1. . . I '$P(X,"^",2) S PRCPFCOS=1,%="<NONE>"
  1. . . S LINE=LINE+1
  1. . . I ITEMDA D SET("WARNING: ITEM NOT STORED IN INVENTORY POINT, COST TO: "_%,LINE,6,80)
  1. . . I 'ITEMDA D SET("WARNING: NO ITEM MASTER NUMBER, COST TO: "_%,LINE,6,80)
  1. . ;
  1. . ; check for errors
  1. . I $P($G(^PRCS(410,TRANDA,0)),"^",6)'=PRCPINPT S LINE=LINE+1,PRCPFLAG=1 D SET("ERROR: INVENTORY POINT NOT TIED TO 2237 ("_$P($G(PRCS(410,TRANDA,0)),"^")_")",LINE,6,80,IORVON,IORVOFF)
  1. . I $D(^PRCP(445,PRCPINPT,1,ITEMDA,0)),TRANDATA="",QTYRECVE>0 S LINE=LINE+1,PRCPFLAG=1 D SET("ERROR: 2237 ("_$P($G(^PRCS(410,TRANDA,0)),"^")_") NOT ESTABLISHED AS A DUE-IN",LINE,6,80,IORVON,IORVOFF)
  1. . S POUI=$$UNITVAL^PRCPUX1($P(PODATA,"^",12),$P(PODATA,"^",3),"/")
  1. . I TRANDATA'="",POUI'=TRUI S LINE=LINE+1,PRCPFLAG=1 D SET("ERROR: PO U/I ("_POUI_") DOES NOT EQUAL DUE-IN U/R ("_TRUI_")",LINE,6,80,IORVON,IORVOFF)
  1. . I $P(QTYRECVE,".",2) S LINE=LINE+1,PRCPFLAG=1 D SET("ERROR: RECEIVING QUANTITY CANNOT BE A FRACTION",LINE,6,80,IORVON,IORVOFF)
  1. . I $D(^PRCP(445,PRCPINPT,1,ITEMDA,0)),'CONV S LINE=LINE+1,PRCPFLAG=1 D SET("ERROR: NO CONVERSION FACTOR. EDIT THE DUE-IN OR VENDOR TO SET THE CF",LINE,6,80,IORVON,IORVOFF)
  1. . I PRCPFLAG S VALMSG="FIX ERRORS BEFORE RECEIVING" Q
  1. . S ^TMP($J,"PRCPPOLMREC",LINEDA)=ITEMDA_"^"_QTYRECVE_"^"_TOTCOST_"^"_TRANDA_"^"_POUI
  1. S VALMCNT=LINE
  1. Q
  1. ;
  1. ;
  1. SET(STRING,LINE,COLUMN,CLREND,ON,OFF) ; set array
  1. I '$D(@VALMAR@(LINE,0)) D SET^VALM10(LINE,$J("",80))
  1. D SET^VALM10(LINE,$$SETSTR^VALM1(STRING,@VALMAR@(LINE,0),COLUMN,CLREND))
  1. I $G(ON)]""!($G(OFF)]"") D CNTRL^VALM10(LINE,COLUMN,$L(STRING),ON,OFF)
  1. Q