source: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPAWS0.m@ 1185

Last change on this file since 1185 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.7 KB
Line 
1PRCPAWS0 ;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
8SUPPLY ; 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)
50Q K ^TMP($J,"PRCPAWS0")
51 Q
Note: See TracBrowser for help on using the repository browser.