| [613] | 1 | PRCPAWS0 ;WISC/RFJ-adjust inventory level - supply only adjustment ;11 Mar 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 | ; called from prcpawa0 for type 4 supply only adjustment
|
|---|
| 8 | SUPPLY ; supply only adjustment
|
|---|
| 9 | ; select item from the inventory point and ask for input.
|
|---|
| 10 | N DATA,ITEMDA,ITEMDATA,ORDERNO,PRCPAWN0,PRCPID,QTY,REASON,VALUE
|
|---|
| 11 | K X S X(1)="NOTE: ITEMS ADJUSTED UNDER THIS OPTION WILL NOT AUTOMATICALLY CREATE THE FMS OR ISMS CODE SHEETS. THE CODE SHEETS WILL HAVE TO BE MANUALLY CREATED." W ! D DISPLAY^PRCPUX2(5,75,.X)
|
|---|
| 12 | K ^TMP($J,"PRCPAWS0")
|
|---|
| 13 | F D Q:'ITEMDA W !!!!!
|
|---|
| 14 | . W !!," >> Select an item number from the ",PRCP("IN")," inventory point. <<"
|
|---|
| 15 | . S ITEMDA=$$ITEM^PRCPUITM(PRCP("I"),0,"","") I 'ITEMDA Q
|
|---|
| 16 | . D SHOWDATA^PRCPAWA0(PRCP("I"),ITEMDA)
|
|---|
| 17 | . ;
|
|---|
| 18 | . ; item already selected
|
|---|
| 19 | . I $D(^TMP($J,"PRCPAWS0","PROCESS",ITEMDA)) S XP=" THIS ITEM WAS PREVIOUSLY SELECTED DURING THIS SELECTION PROCESS.",XP(1)=" OK TO REMOVE THIS ADJUSTMENT SO YOU CAN ENTER A NEW ONE" W !! I $$YN^PRCPUYN(1)'=1 Q
|
|---|
| 20 | . K ^TMP($J,"PRCPAWS0","PROCESS",ITEMDA)
|
|---|
| 21 | . ;
|
|---|
| 22 | . ; enter adjustment
|
|---|
| 23 | . S ITEMDATA=$G(^PRCP(445,PRCP("I"),1,ITEMDA,0)) I ITEMDATA="" Q
|
|---|
| 24 | . W !!,"**************** E N T E R A D J U S T M E N T D A T A ****************",!
|
|---|
| 25 | . S QTY=$$QTY^PRCPAWU0(-$P(ITEMDATA,"^",7),99998) I QTY["^" Q
|
|---|
| 26 | . S VALUE=$$VALUE^PRCPAWU0(-99999.99,99999.99," INVENTORY","") I VALUE["^" Q
|
|---|
| 27 | . I 'QTY,'VALUE W !!?10,">> EITHER QUANTITY OR VALUE NEEDS TO BE ENTERED FOR AN ADJUSTMENT <<" Q
|
|---|
| 28 | . W ! S REASON=$$REASON^PRCPAWU0("") I REASON["^" Q
|
|---|
| 29 | . S ^TMP($J,"PRCPAWS0","PROCESS",ITEMDA)=QTY_"^^"_VALUE_"^^^^"_REASON
|
|---|
| 30 | ;
|
|---|
| 31 | I ITEMDA["^" D Q Q
|
|---|
| 32 | I '$O(^TMP($J,"PRCPAWS0","PROCESS",0)) W !!?10,">> NO ITEMS HAVE BEEN SELECTED <<" D Q Q
|
|---|
| 33 | ;
|
|---|
| 34 | K X S X(1)="NOTE: ITEMS ADJUSTED UNDER THIS OPTION WILL NOT AUTOMATICALLY CREATE THE FMS OR ISMS CODE SHEETS. THE CODE SHEETS WILL HAVE TO BE MANUALLY CREATED." W ! D DISPLAY^PRCPUX2(5,75,.X)
|
|---|
| 35 | S XP="READY TO PROCESS INVENTORY ADJUSTMENTS",XH="Enter YES to PROCESS the INVENTORY adjustments, NO to exit."
|
|---|
| 36 | W !! I $$YN^PRCPUYN(1)'=1 D Q Q
|
|---|
| 37 | ;
|
|---|
| 38 | ; process inventory adjustments
|
|---|
| 39 | S ORDERNO=$$ORDERNO^PRCPUTRX(PRCP("I"))
|
|---|
| 40 | S ITEMDA=0 F S ITEMDA=$O(^TMP($J,"PRCPAWS0","PROCESS",ITEMDA)) Q:'ITEMDA S DATA=^(ITEMDA) I DATA'="" D
|
|---|
| 41 | . K PRCPAWN0
|
|---|
| 42 | . S PRCPAWN0("QTY")=$P(DATA,"^"),PRCPAWN0("INVVAL")=$P(DATA,"^",3),PRCPAWN0("SELVAL")=0,PRCPAWN0("REASON")="0:"_$P(DATA,"^",7),PRCPAWN0("2237PO")=PRC("SITE")
|
|---|
| 43 | . D ITEM^PRCPUUIW(PRCP("I"),ITEMDA,"A",ORDERNO,.PRCPAWN0)
|
|---|
| 44 | . K PRCPAWN0
|
|---|
| 45 | ;
|
|---|
| 46 | ; create log or isms code sheets
|
|---|
| 47 | D CODESHTS^PRCPAWC0(PRCP("I"),"A"_ORDERNO)
|
|---|
| 48 | ; print form
|
|---|
| 49 | D PRINFORM^PRCPAWR0("A"_ORDERNO)
|
|---|
| 50 | Q K ^TMP($J,"PRCPAWS0")
|
|---|
| 51 | Q
|
|---|
