Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCPAWS0

PRCPAWS0.m

Go to the documentation of this file.
PRCPAWS0 ;WISC/RFJ-adjust inventory level - supply only adjustment  ;11 Mar 94
 ;;5.1;IFCAP;;Oct 20, 2000
 ;Per VHA Directive 10-93-142, this routine should not be modified.
 Q
 ;
 ;
 ;  called from prcpawa0 for type 4 supply only adjustment
SUPPLY ;  supply only adjustment
 ;  select item from the inventory point and ask for input.
 N DATA,ITEMDA,ITEMDATA,ORDERNO,PRCPAWN0,PRCPID,QTY,REASON,VALUE
 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)
 K ^TMP($J,"PRCPAWS0")
 F  D  Q:'ITEMDA  W !!!!!
 .   W !!,"  >> Select an item number from the ",PRCP("IN")," inventory point. <<"
 .   S ITEMDA=$$ITEM^PRCPUITM(PRCP("I"),0,"","") I 'ITEMDA Q
 .   D SHOWDATA^PRCPAWA0(PRCP("I"),ITEMDA)
 .   ;
 .   ;  item already selected
 .   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
 .   K ^TMP($J,"PRCPAWS0","PROCESS",ITEMDA)
 .   ;
 .   ;  enter adjustment
 .   S ITEMDATA=$G(^PRCP(445,PRCP("I"),1,ITEMDA,0)) I ITEMDATA="" Q
 .   W !!,"****************  E N T E R    A D J U S T M E N T    D A T A  ****************",!
 .   S QTY=$$QTY^PRCPAWU0(-$P(ITEMDATA,"^",7),99998) I QTY["^" Q
 .   S VALUE=$$VALUE^PRCPAWU0(-99999.99,99999.99," INVENTORY","") I VALUE["^" Q
 .   I 'QTY,'VALUE W !!?10,">> EITHER QUANTITY OR VALUE NEEDS TO BE ENTERED FOR AN ADJUSTMENT <<" Q
 .   W ! S REASON=$$REASON^PRCPAWU0("") I REASON["^" Q
 .   S ^TMP($J,"PRCPAWS0","PROCESS",ITEMDA)=QTY_"^^"_VALUE_"^^^^"_REASON
 ;
 I ITEMDA["^" D Q Q
 I '$O(^TMP($J,"PRCPAWS0","PROCESS",0)) W !!?10,">> NO ITEMS HAVE BEEN SELECTED <<" D Q Q
 ;
 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)
 S XP="READY TO PROCESS INVENTORY ADJUSTMENTS",XH="Enter YES to PROCESS the INVENTORY adjustments, NO to exit."
 W !! I $$YN^PRCPUYN(1)'=1 D Q Q
 ;
 ;  process inventory adjustments
 S ORDERNO=$$ORDERNO^PRCPUTRX(PRCP("I"))
 S ITEMDA=0 F  S ITEMDA=$O(^TMP($J,"PRCPAWS0","PROCESS",ITEMDA)) Q:'ITEMDA  S DATA=^(ITEMDA) I DATA'="" D
 .   K PRCPAWN0
 .   S PRCPAWN0("QTY")=$P(DATA,"^"),PRCPAWN0("INVVAL")=$P(DATA,"^",3),PRCPAWN0("SELVAL")=0,PRCPAWN0("REASON")="0:"_$P(DATA,"^",7),PRCPAWN0("2237PO")=PRC("SITE")
 .   D ITEM^PRCPUUIW(PRCP("I"),ITEMDA,"A",ORDERNO,.PRCPAWN0)
 .   K PRCPAWN0
 ;
 ;  create log or isms code sheets
 D CODESHTS^PRCPAWC0(PRCP("I"),"A"_ORDERNO)
 ;  print form
 D PRINFORM^PRCPAWR0("A"_ORDERNO)
Q K ^TMP($J,"PRCPAWS0")
 Q