| 1 | PRCPWPLB ;WISC/RFJ-whse post issue book (build array) ;13 Jan 94
|
|---|
| 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 | REBUILD ; rebuild array
|
|---|
| 8 | K ^TMP($J,"PRCPWPLM"),^TMP($J,"PRCPWPLMLIST"),PRCPFERR
|
|---|
| 9 | N DATA,IBQTY,INVDATA,ITEMDA,LINE,LINEDA,ONHAND,QTYOUT,QTYPOST,STATUS,UNITCOST,X
|
|---|
| 10 | S LINE=0
|
|---|
| 11 | S LINEDA=0 F S LINEDA=$O(^PRCS(410,PRCPDA,"IT",LINEDA)) Q:'LINEDA S DATA=$G(^(LINEDA,0)) I DATA'="" D
|
|---|
| 12 | . S ITEMDA=+$P(DATA,"^",5),IBQTY=+$P(DATA,"^",2),QTYOUT=$P(DATA,"^",2)-$P(DATA,"^",12),STATUS=$P(DATA,"^",14)
|
|---|
| 13 | . S INVDATA=$G(^PRCP(445,PRCPINPT,1,ITEMDA,0)),ONHAND=+$P(INVDATA,"^",7)
|
|---|
| 14 | . S UNITCOST=$P(INVDATA,"^",22) S:$P(INVDATA,"^",15)>UNITCOST UNITCOST=$P(INVDATA,"^",15) S:$P(DATA,"^",7)>UNITCOST UNITCOST=$P(DATA,"^",7)
|
|---|
| 15 | . S QTYPOST=+$G(^TMP($J,"PRCPWPLMPOST",LINEDA))
|
|---|
| 16 | . S LINE=LINE+1
|
|---|
| 17 | . D SET(LINEDA,LINE,1,80,IORVON,IORVOFF)
|
|---|
| 18 | . D SET($$DESCR^PRCPUX1(PRCPINPT,ITEMDA),LINE,6,23)
|
|---|
| 19 | . D SET($J(ITEMDA,6),LINE,24,29)
|
|---|
| 20 | . D SET($J($$UNIT^PRCPUX1(PRCPINPT,ITEMDA,"/"),7),LINE,30,36)
|
|---|
| 21 | . D SET($J(ONHAND,10),LINE,37,46)
|
|---|
| 22 | . D SET($J(UNITCOST,10,2),LINE,47,56)
|
|---|
| 23 | . D SET($J(IBQTY,8),LINE,57,64)
|
|---|
| 24 | . D SET($J(QTYOUT,8),LINE,65,72)
|
|---|
| 25 | . D SET($J(QTYPOST,8),LINE,73,80)
|
|---|
| 26 | . I $G(PRCPFNSN) S LINE=LINE+1 D SET("NSN: "_$$NSN^PRCPUX1(ITEMDA),LINE,6,80)
|
|---|
| 27 | . I STATUS'="" S QTYOUT=0,%="ITEM IS CANCELLED"_$S(STATUS["S":" AND SUBSTITUTED WITH LINE #(S): "_$P(STATUS,",",2,99),1:"") S LINE=LINE+1 D SET(%,LINE,6,80)
|
|---|
| 28 | . I STATUS="",QTYPOST D
|
|---|
| 29 | . . I INVDATA="" S PRCPFERR=1,LINE=LINE+1 D SET("ERROR: ITEM NOT STORED IN WAREHOUSE INVENTORY POINT",LINE,6,80,IORVON,IORVOFF)
|
|---|
| 30 | . . I $$NSN^PRCPUX1(ITEMDA)="" S PRCPFERR=1,LINE=LINE+1 D SET("ERROR: NSN IS MISSING FROM ITEM MASTER FILE",LINE,6,80,IORVON,IORVOFF)
|
|---|
| 31 | . . I '$P(INVDATA,"^",14)!('$P(INVDATA,"^",5)) S PRCPFERR=1,LINE=LINE+1 D SET("ERROR: UNIT OF ISSUE IS MISSING FOR THE WAREHOUSE INVENTORY POINT",LINE,6,80,IORVON,IORVOFF)
|
|---|
| 32 | . I INVDATA'="",ONHAND-QTYPOST<0 S LINE=LINE+1 D SET("WARNING: AFTER POSTING, QUANTITY ONHAND WILL BE LESS THAN ZERO",LINE,6,80,IORVON,IORVOFF)
|
|---|
| 33 | . S ^TMP($J,"PRCPWPLMLIST",LINEDA)=ITEMDA_"^"_QTYOUT
|
|---|
| 34 | S VALMCNT=LINE
|
|---|
| 35 | Q
|
|---|
| 36 | ;
|
|---|
| 37 | ;
|
|---|
| 38 | SET(STRING,LINE,COLUMN,CLREND,ON,OFF) ; set array
|
|---|
| 39 | I '$D(@VALMAR@(LINE,0)) D SET^VALM10(LINE,$J("",80))
|
|---|
| 40 | D SET^VALM10(LINE,$$SETSTR^VALM1(STRING,@VALMAR@(LINE,0),COLUMN,CLREND))
|
|---|
| 41 | I $G(ON)]""!($G(OFF)]"") D CNTRL^VALM10(LINE,COLUMN,$L(STRING),ON,OFF)
|
|---|
| 42 | Q
|
|---|
