- PRCPWPLB ;WISC/RFJ-whse post issue book (build array) ;13 Jan 94
- ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- Q
- ;
- ;
- REBUILD ; rebuild array
- K ^TMP($J,"PRCPWPLM"),^TMP($J,"PRCPWPLMLIST"),PRCPFERR
- N DATA,IBQTY,INVDATA,ITEMDA,LINE,LINEDA,ONHAND,QTYOUT,QTYPOST,STATUS,UNITCOST,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),IBQTY=+$P(DATA,"^",2),QTYOUT=$P(DATA,"^",2)-$P(DATA,"^",12),STATUS=$P(DATA,"^",14)
- . S INVDATA=$G(^PRCP(445,PRCPINPT,1,ITEMDA,0)),ONHAND=+$P(INVDATA,"^",7)
- . S UNITCOST=$P(INVDATA,"^",22) S:$P(INVDATA,"^",15)>UNITCOST UNITCOST=$P(INVDATA,"^",15) S:$P(DATA,"^",7)>UNITCOST UNITCOST=$P(DATA,"^",7)
- . S QTYPOST=+$G(^TMP($J,"PRCPWPLMPOST",LINEDA))
- . S LINE=LINE+1
- . D SET(LINEDA,LINE,1,80,IORVON,IORVOFF)
- . D SET($$DESCR^PRCPUX1(PRCPINPT,ITEMDA),LINE,6,23)
- . D SET($J(ITEMDA,6),LINE,24,29)
- . D SET($J($$UNIT^PRCPUX1(PRCPINPT,ITEMDA,"/"),7),LINE,30,36)
- . D SET($J(ONHAND,10),LINE,37,46)
- . D SET($J(UNITCOST,10,2),LINE,47,56)
- . D SET($J(IBQTY,8),LINE,57,64)
- . D SET($J(QTYOUT,8),LINE,65,72)
- . D SET($J(QTYPOST,8),LINE,73,80)
- . I $G(PRCPFNSN) S LINE=LINE+1 D SET("NSN: "_$$NSN^PRCPUX1(ITEMDA),LINE,6,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="",QTYPOST D
- . . I INVDATA="" S PRCPFERR=1,LINE=LINE+1 D SET("ERROR: ITEM NOT STORED IN WAREHOUSE INVENTORY POINT",LINE,6,80,IORVON,IORVOFF)
- . . 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)
- . . 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)
- . 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)
- . S ^TMP($J,"PRCPWPLMLIST",LINEDA)=ITEMDA_"^"_QTYOUT
- 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[HPRCPWPLB 2490 printed Mar 13, 2025@21:21:33 Page 2
- PRCPWPLB ;WISC/RFJ-whse post issue book (build array) ;13 Jan 94
- +1 ;;5.1;IFCAP;;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,"PRCPWPLM"),^TMP($JOB,"PRCPWPLMLIST"),PRCPFERR
- +2 NEW DATA,IBQTY,INVDATA,ITEMDA,LINE,LINEDA,ONHAND,QTYOUT,QTYPOST,STATUS,UNITCOST,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 IBQTY=+$PIECE(DATA,"^",2)
- SET QTYOUT=$PIECE(DATA,"^",2)-$PIECE(DATA,"^",12)
- SET STATUS=$PIECE(DATA,"^",14)
- +6 SET INVDATA=$GET(^PRCP(445,PRCPINPT,1,ITEMDA,0))
- SET ONHAND=+$PIECE(INVDATA,"^",7)
- +7 SET UNITCOST=$PIECE(INVDATA,"^",22)
- if $PIECE(INVDATA,"^",15)>UNITCOST
- SET UNITCOST=$PIECE(INVDATA,"^",15)
- if $PIECE(DATA,"^",7)>UNITCOST
- SET UNITCOST=$PIECE(DATA,"^",7)
- +8 SET QTYPOST=+$GET(^TMP($JOB,"PRCPWPLMPOST",LINEDA))
- +9 SET LINE=LINE+1
- +10 DO SET(LINEDA,LINE,1,80,IORVON,IORVOFF)
- +11 DO SET($$DESCR^PRCPUX1(PRCPINPT,ITEMDA),LINE,6,23)
- +12 DO SET($JUSTIFY(ITEMDA,6),LINE,24,29)
- +13 DO SET($JUSTIFY($$UNIT^PRCPUX1(PRCPINPT,ITEMDA,"/"),7),LINE,30,36)
- +14 DO SET($JUSTIFY(ONHAND,10),LINE,37,46)
- +15 DO SET($JUSTIFY(UNITCOST,10,2),LINE,47,56)
- +16 DO SET($JUSTIFY(IBQTY,8),LINE,57,64)
- +17 DO SET($JUSTIFY(QTYOUT,8),LINE,65,72)
- +18 DO SET($JUSTIFY(QTYPOST,8),LINE,73,80)
- +19 IF $GET(PRCPFNSN)
- SET LINE=LINE+1
- DO SET("NSN: "_$$NSN^PRCPUX1(ITEMDA),LINE,6,80)
- +20 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)
- +21 IF STATUS=""
- IF QTYPOST
- Begin DoDot:2
- +22 IF INVDATA=""
- SET PRCPFERR=1
- SET LINE=LINE+1
- DO SET("ERROR: ITEM NOT STORED IN WAREHOUSE INVENTORY POINT",LINE,6,80,IORVON,IORVOFF)
- +23 IF $$NSN^PRCPUX1(ITEMDA)=""
- SET PRCPFERR=1
- SET LINE=LINE+1
- DO SET("ERROR: NSN IS MISSING FROM ITEM MASTER FILE",LINE,6,80,IORVON,IORVOFF)
- +24 IF '$PIECE(INVDATA,"^",14)!('$PIECE(INVDATA,"^",5))
- SET PRCPFERR=1
- SET LINE=LINE+1
- DO SET("ERROR: UNIT OF ISSUE IS MISSING FOR THE WAREHOUSE INVENTORY POINT",LINE,6,80,IORVON,IORVOFF)
- End DoDot:2
- +25 IF INVDATA'=""
- IF ONHAND-QTYPOST<0
- SET LINE=LINE+1
- DO SET("WARNING: AFTER POSTING, QUANTITY ONHAND WILL BE LESS THAN ZERO",LINE,6,80,IORVON,IORVOFF)
- +26 SET ^TMP($JOB,"PRCPWPLMLIST",LINEDA)=ITEMDA_"^"_QTYOUT
- 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
