1 | PRCPWPPB ;WISC/DWA,RFJ-primary receive issue book (build array) ;20 Jan 94
|
---|
2 | ;;5.1;IFCAP;**4**;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,"PRCPWPPL"),^TMP($J,"PRCPWPPLLIST")
|
---|
9 | N DATA,INVDATA,ITEMDA,LINE,LINEDA,QTYOUT,QTYPST,STATUS,UNITREC,VENDOR,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),QTYOUT=$P(DATA,"^",2)-$P(DATA,"^",13),STATUS=$P(DATA,"^",14),QTYPST=$P(DATA,"^",12)-$P(DATA,"^",13)
|
---|
13 | . S INVDATA=$G(^PRCP(445,PRCPINPT,1,ITEMDA,0))
|
---|
14 | . S VENDOR=$$GETVEN^PRCPUVEN(PRCPINPT,ITEMDA,PRCPPVNO,1)
|
---|
15 | . S UNITREC=$$UNITVAL^PRCPUX1($P(VENDOR,"^",3),$P(VENDOR,"^",2),"/")
|
---|
16 | . S LINE=LINE+1
|
---|
17 | . D SET(LINEDA,LINE,1,80,IORVON,IORVOFF)
|
---|
18 | . D SET($$DESCR^PRCPUX1(PRCPINPT,ITEMDA),LINE,6,35)
|
---|
19 | . D SET($J(ITEMDA,7),LINE,36,42)
|
---|
20 | . D SET($J($$NSN^PRCPUX1(ITEMDA),19),LINE,43,60)
|
---|
21 | . S LINE=LINE+1
|
---|
22 | . D SET($J($$UNIT^PRCPUX1(PRCPINPT,ITEMDA,"/"),7),LINE,8,80)
|
---|
23 | . D SET($J($P(VENDOR,"^",4),7),LINE,15,21)
|
---|
24 | . D SET($J(UNITREC,7),LINE,22,28)
|
---|
25 | . D SET($J(+$P(INVDATA,"^",22),10,2),LINE,29,38)
|
---|
26 | . D SET($J(+$P(DATA,"^",7),10,2),LINE,39,48)
|
---|
27 | . D SET($J(+$P(DATA,"^",2),8),LINE,49,56)
|
---|
28 | . D SET($J(+$P(DATA,"^",12),8),LINE,57,64)
|
---|
29 | . D SET($J(+$P(DATA,"^",13),8),LINE,65,72)
|
---|
30 | . D SET($J(+$G(^TMP($J,"PRCPWPPLPOST",LINEDA)),8),LINE,73,80)
|
---|
31 | . 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)
|
---|
32 | . I STATUS="",INVDATA="" S LINE=LINE+1 D SET("WARNING: ITEM NOT STORED IN PRIMARY INVENTORY POINT",LINE,6,80,IORVON,IORVOFF)
|
---|
33 | . S ^TMP($J,"PRCPWPPLLIST",LINEDA)=ITEMDA_"^"_QTYOUT_"^"_QTYPST
|
---|
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
|
---|