PRCPWPPB ;WISC/DWA,RFJ-primary receive issue book (build array) ;20 Jan 94
;;5.1;IFCAP;**4**;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
REBUILD ; rebuild array
K ^TMP($J,"PRCPWPPL"),^TMP($J,"PRCPWPPLLIST")
N DATA,INVDATA,ITEMDA,LINE,LINEDA,QTYOUT,QTYPST,STATUS,UNITREC,VENDOR,X
S LINE=0
S LINEDA=0 F S LINEDA=$O(^PRCS(410,PRCPDA,"IT",LINEDA)) Q:'LINEDA S DATA=$G(^(LINEDA,0)) I DATA'="" D
. S ITEMDA=+$P(DATA,"^",5),QTYOUT=$P(DATA,"^",2)-$P(DATA,"^",13),STATUS=$P(DATA,"^",14),QTYPST=$P(DATA,"^",12)-$P(DATA,"^",13)
. S INVDATA=$G(^PRCP(445,PRCPINPT,1,ITEMDA,0))
. S VENDOR=$$GETVEN^PRCPUVEN(PRCPINPT,ITEMDA,PRCPPVNO,1)
. S UNITREC=$$UNITVAL^PRCPUX1($P(VENDOR,"^",3),$P(VENDOR,"^",2),"/")
. S LINE=LINE+1
. D SET(LINEDA,LINE,1,80,IORVON,IORVOFF)
. D SET($$DESCR^PRCPUX1(PRCPINPT,ITEMDA),LINE,6,35)
. D SET($J(ITEMDA,7),LINE,36,42)
. D SET($J($$NSN^PRCPUX1(ITEMDA),19),LINE,43,60)
. S LINE=LINE+1
. D SET($J($$UNIT^PRCPUX1(PRCPINPT,ITEMDA,"/"),7),LINE,8,80)
. D SET($J($P(VENDOR,"^",4),7),LINE,15,21)
. D SET($J(UNITREC,7),LINE,22,28)
. D SET($J(+$P(INVDATA,"^",22),10,2),LINE,29,38)
. D SET($J(+$P(DATA,"^",7),10,2),LINE,39,48)
. D SET($J(+$P(DATA,"^",2),8),LINE,49,56)
. D SET($J(+$P(DATA,"^",12),8),LINE,57,64)
. D SET($J(+$P(DATA,"^",13),8),LINE,65,72)
. D SET($J(+$G(^TMP($J,"PRCPWPPLPOST",LINEDA)),8),LINE,73,80)
. 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)
. I STATUS="",INVDATA="" S LINE=LINE+1 D SET("WARNING: ITEM NOT STORED IN PRIMARY INVENTORY POINT",LINE,6,80,IORVON,IORVOFF)
. S ^TMP($J,"PRCPWPPLLIST",LINEDA)=ITEMDA_"^"_QTYOUT_"^"_QTYPST
S VALMCNT=LINE
Q
;
;
SET(STRING,LINE,COLUMN,CLREND,ON,OFF) ; set array
I '$D(@VALMAR@(LINE,0)) D SET^VALM10(LINE,$J("",80))
D SET^VALM10(LINE,$$SETSTR^VALM1(STRING,@VALMAR@(LINE,0),COLUMN,CLREND))
I $G(ON)]""!($G(OFF)]"") D CNTRL^VALM10(LINE,COLUMN,$L(STRING),ON,OFF)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPWPPB 2115 printed Apr 09, 2024@21:04:07 Page 2
PRCPWPPB ;WISC/DWA,RFJ-primary receive issue book (build array) ;20 Jan 94
+1 ;;5.1;IFCAP;**4**;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
REBUILD ; rebuild array
+1 KILL ^TMP($JOB,"PRCPWPPL"),^TMP($JOB,"PRCPWPPLLIST")
+2 NEW DATA,INVDATA,ITEMDA,LINE,LINEDA,QTYOUT,QTYPST,STATUS,UNITREC,VENDOR,X
+3 SET LINE=0
+4 SET LINEDA=0
FOR
SET LINEDA=$ORDER(^PRCS(410,PRCPDA,"IT",LINEDA))
if 'LINEDA
QUIT
SET DATA=$GET(^(LINEDA,0))
IF DATA'=""
Begin DoDot:1
+5 SET ITEMDA=+$PIECE(DATA,"^",5)
SET QTYOUT=$PIECE(DATA,"^",2)-$PIECE(DATA,"^",13)
SET STATUS=$PIECE(DATA,"^",14)
SET QTYPST=$PIECE(DATA,"^",12)-$PIECE(DATA,"^",13)
+6 SET INVDATA=$GET(^PRCP(445,PRCPINPT,1,ITEMDA,0))
+7 SET VENDOR=$$GETVEN^PRCPUVEN(PRCPINPT,ITEMDA,PRCPPVNO,1)
+8 SET UNITREC=$$UNITVAL^PRCPUX1($PIECE(VENDOR,"^",3),$PIECE(VENDOR,"^",2),"/")
+9 SET LINE=LINE+1
+10 DO SET(LINEDA,LINE,1,80,IORVON,IORVOFF)
+11 DO SET($$DESCR^PRCPUX1(PRCPINPT,ITEMDA),LINE,6,35)
+12 DO SET($JUSTIFY(ITEMDA,7),LINE,36,42)
+13 DO SET($JUSTIFY($$NSN^PRCPUX1(ITEMDA),19),LINE,43,60)
+14 SET LINE=LINE+1
+15 DO SET($JUSTIFY($$UNIT^PRCPUX1(PRCPINPT,ITEMDA,"/"),7),LINE,8,80)
+16 DO SET($JUSTIFY($PIECE(VENDOR,"^",4),7),LINE,15,21)
+17 DO SET($JUSTIFY(UNITREC,7),LINE,22,28)
+18 DO SET($JUSTIFY(+$PIECE(INVDATA,"^",22),10,2),LINE,29,38)
+19 DO SET($JUSTIFY(+$PIECE(DATA,"^",7),10,2),LINE,39,48)
+20 DO SET($JUSTIFY(+$PIECE(DATA,"^",2),8),LINE,49,56)
+21 DO SET($JUSTIFY(+$PIECE(DATA,"^",12),8),LINE,57,64)
+22 DO SET($JUSTIFY(+$PIECE(DATA,"^",13),8),LINE,65,72)
+23 DO SET($JUSTIFY(+$GET(^TMP($JOB,"PRCPWPPLPOST",LINEDA)),8),LINE,73,80)
+24 IF STATUS'=""
SET QTYOUT=0
SET %="ITEM IS CANCELLED"_$SELECT(STATUS["S":" AND SUBSTITUTED WITH LINE #(S): "_$PIECE(STATUS,",",2,99),1:"")
SET LINE=LINE+1
DO SET(%,LINE,6,80)
+25 IF STATUS=""
IF INVDATA=""
SET LINE=LINE+1
DO SET("WARNING: ITEM NOT STORED IN PRIMARY INVENTORY POINT",LINE,6,80,IORVON,IORVOFF)
+26 SET ^TMP($JOB,"PRCPWPPLLIST",LINEDA)=ITEMDA_"^"_QTYOUT_"^"_QTYPST
End DoDot:1
+27 SET VALMCNT=LINE
+28 QUIT
+29 ;
+30 ;
SET(STRING,LINE,COLUMN,CLREND,ON,OFF) ; set array
+1 IF '$DATA(@VALMAR@(LINE,0))
DO SET^VALM10(LINE,$JUSTIFY("",80))
+2 DO SET^VALM10(LINE,$$SETSTR^VALM1(STRING,@VALMAR@(LINE,0),COLUMN,CLREND))
+3 IF $GET(ON)]""!($GET(OFF)]"")
DO CNTRL^VALM10(LINE,COLUMN,$LENGTH(STRING),ON,OFF)
+4 QUIT
