close Warning: Can't use blame annotator: 
svn blame failed on WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPEIQT.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPEIQT.m@ 1464

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

initial load of WorldVistAEHR
File size: 2.3 KB
RevLine 
1PRCPEIQT ;WISC/RFJ-edit quantities, dueins, costs ; 5/4/99 3:40pm
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7QTY(PRCPINPT,ITEMDA) ; adjust primary or secondary quantity
8 N %,ITEMDATA,ORDERNO,PRCPEIQT,PRCPID,QTY,REASON,VALUE,X,Y
9 S ITEMDATA=$G(^PRCP(445,PRCPINPT,1,ITEMDA,0)) I ITEMDATA="" Q
10 W !!?3,"QTY ON-HAND (in ",$$UNIT^PRCPUX1(PRCPINPT,ITEMDA," per "),"): ",+$P(ITEMDATA,"^",7)
11 W !?10,"x",?16,"AVERAGE COST: ",$J(+$P(ITEMDATA,"^",22),0,3)
12 W !?10,"=",?13,"INVENTORY VALUE: ",$J(+$P(ITEMDATA,"^",27),0,2),!
13 S QTY=$$QTY^PRCPAWU0(-99999,99999) Q:QTY["^"
14 W ! S VALUE=$$VALUE^PRCPAWU0(-9999999.99,9999999.99,"",0) Q:VALUE["^"
15 S QTY=+QTY,VALUE=+VALUE I QTY=0,VALUE=0 Q
16 W ! S REASON=$$REASON^PRCPAWU0("") Q:REASON["^"
17 S ORDERNO=$$ORDERNO^PRCPUTRX(PRCPINPT)
18 K PRCPEIQT S PRCPEIQT("QTY")=QTY,PRCPEIQT("INVVAL")=VALUE,PRCPEIQT("SELVAL")=0,PRCPEIQT("REASON")="0:"_REASON,PRCPEIQT("2237PO")=""
19 D ITEM^PRCPUUIW(PRCPINPT,ITEMDA,"A",ORDERNO,.PRCPEIQT)
20 Q
21 ;
22 ;
23DUEIN(PRCPINPT,ITEMDA) ; change primary or secondary due-ins
24 N %,%H,D,D0,D1,DA,DD,DDC,DDH,DI,DIC,DIE,DIX,DIY,DIZ,DO,DQ,DR,DZ,ITEMDATA,PRCPTYPE,X,Y,Z
25 S ITEMDATA=$G(^PRCP(445,PRCPINPT,1,ITEMDA,0)) I ITEMDATA="" Q
26 S PRCPTYPE=$P(^PRCP(445,PRCPINPT,0),"^",3)
27 W !!?3,"QTY DUE-IN (in ",$$UNIT^PRCPUX1(PRCPINPT,ITEMDA," per "),"): ",$$GETIN^PRCPUDUE(PRCPINPT,ITEMDA),!
28 S:'$D(^PRCP(445,PRCPINPT,1,ITEMDA,7,0)) ^(0)="^445.09P^^"
29 S (DIC,DIE)="^PRCP(445,"_PRCPINPT_",1,",DA(1)=PRCPINPT,DA=ITEMDA,DR=$S(PRCPTYPE="S":8.1,1:20)
30 D ^DIE
31 I PRCPTYPE="S" Q
32 S (X,Y)=0 F S X=$O(^PRCP(445,PRCPINPT,1,ITEMDA,7,X)) Q:'X S Y=Y+$P($G(^(X,0)),"^",2)
33 S X=Y-$$GETIN^PRCPUDUE(PRCPINPT,ITEMDA) I X W !?5,"...total DUE-IN QUANTITY adjusted (by: ",X,") to: ",Y D SETIN^PRCPUDUE(PRCPINPT,ITEMDA,X),R^PRCPUREP
34 Q
35 ;
36 ;
37COSTEDIT(PRCPINPT,ITEMDA) ; edit last cost for invpt and item
38 N %,D,D0,DA,DI,DIC,DIE,DQ,DR,DZ,X,X1,Y,Y1
39CE1 S DA(1)=PRCPINPT,DA=ITEMDA,(DIC,DIE)="^PRCP(445,"_PRCPINPT_",1,",DR="4.7LAST COST;"
40 D ^DIE
41 S X1=$P(^PRCP(445,PRCPINPT,1,ITEMDA,0),"^",22),X=$P(^PRCP(445,PRCPINPT,1,ITEMDA,0),"^",15),Y=X1*1.1,Y1=X1/1.1
42 I X>Y!(X<Y1) D
43 . S Y="",DIR(0)="Y",DIR("B")="YES",DIR("A")="Re-Edit Last Cost"
44 . S DIR("A",1)="** WARNING: Difference between last cost entered "
45 . S DIR("A",2)="and average cost ("_X1_") is more than 10% **"
46 . D ^DIR K DIR
47 . I Y=1 S Y="YES"
48 . Q
49 I Y="YES" G CE1
50 Q
Note: See TracBrowser for help on using the repository browser.