- PRCPEIQT ;WISC/RFJ-edit quantities, dueins, costs ; 5/4/99 3:40pm
- V ;;5.1;IFCAP;**124**;Oct 20, 2000;Build 2
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- Q
- ;
- ;
- QTY(PRCPINPT,ITEMDA) ; adjust primary or secondary quantity
- N %,ITEMDATA,ORDERNO,PRCPEIQT,PRCPID,QTY,REASON,VALUE,X,Y
- S ITEMDATA=$G(^PRCP(445,PRCPINPT,1,ITEMDA,0)) I ITEMDATA="" Q
- W !!?3,"QTY ON-HAND (in ",$$UNIT^PRCPUX1(PRCPINPT,ITEMDA," per "),"): ",+$P(ITEMDATA,"^",7)
- W !?10,"x",?16,"AVERAGE COST: ",$J(+$P(ITEMDATA,"^",22),0,3)
- W !?10,"=",?13,"INVENTORY VALUE: ",$J(+$P(ITEMDATA,"^",27),0,2),!
- S QTY=$$QTY^PRCPAWU0(-99999,99999) Q:QTY["^"
- W ! S VALUE=$$VALUE^PRCPAWU0(-9999999.99,9999999.99,"",0) Q:VALUE["^"
- S QTY=+QTY,VALUE=+VALUE I QTY=0,VALUE=0 Q
- W ! S REASON=$$REASON^PRCPAWU0("",1) Q:REASON["^"
- S ORDERNO=$$ORDERNO^PRCPUTRX(PRCPINPT)
- K PRCPEIQT S PRCPEIQT("QTY")=QTY,PRCPEIQT("INVVAL")=VALUE,PRCPEIQT("SELVAL")=0,PRCPEIQT("REASON")="0:"_REASON,PRCPEIQT("2237PO")=""
- D ITEM^PRCPUUIW(PRCPINPT,ITEMDA,"A",ORDERNO,.PRCPEIQT)
- Q
- ;
- ;
- DUEIN(PRCPINPT,ITEMDA) ; change primary or secondary due-ins
- N %,%H,D,D0,D1,DA,DD,DDC,DDH,DI,DIC,DIE,DIX,DIY,DIZ,DO,DQ,DR,DZ,ITEMDATA,PRCPTYPE,X,Y,Z
- S ITEMDATA=$G(^PRCP(445,PRCPINPT,1,ITEMDA,0)) I ITEMDATA="" Q
- S PRCPTYPE=$P(^PRCP(445,PRCPINPT,0),"^",3)
- W !!?3,"QTY DUE-IN (in ",$$UNIT^PRCPUX1(PRCPINPT,ITEMDA," per "),"): ",$$GETIN^PRCPUDUE(PRCPINPT,ITEMDA),!
- S:'$D(^PRCP(445,PRCPINPT,1,ITEMDA,7,0)) ^(0)="^445.09P^^"
- S (DIC,DIE)="^PRCP(445,"_PRCPINPT_",1,",DA(1)=PRCPINPT,DA=ITEMDA,DR=$S(PRCPTYPE="S":8.1,1:20)
- D ^DIE
- I PRCPTYPE="S" Q
- 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)
- 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
- Q
- ;
- ;
- COSTEDIT(PRCPINPT,ITEMDA) ; edit last cost for invpt and item
- N %,D,D0,DA,DI,DIC,DIE,DQ,DR,DZ,X,X1,Y,Y1
- CE1 S DA(1)=PRCPINPT,DA=ITEMDA,(DIC,DIE)="^PRCP(445,"_PRCPINPT_",1,",DR="4.7LAST COST;"
- D ^DIE
- 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
- I X>Y!(X<Y1) D
- . S Y="",DIR(0)="Y",DIR("B")="YES",DIR("A")="Re-Edit Last Cost"
- . S DIR("A",1)="** WARNING: Difference between last cost entered "
- . S DIR("A",2)="and average cost ("_X1_") is more than 10% **"
- . D ^DIR K DIR
- . I Y=1 S Y="YES"
- . Q
- I Y="YES" G CE1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPEIQT 2472 printed Apr 23, 2025@18:28:09 Page 2
- PRCPEIQT ;WISC/RFJ-edit quantities, dueins, costs ; 5/4/99 3:40pm
- V ;;5.1;IFCAP;**124**;Oct 20, 2000;Build 2
- +1 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +2 QUIT
- +3 ;
- +4 ;
- QTY(PRCPINPT,ITEMDA) ; adjust primary or secondary quantity
- +1 NEW %,ITEMDATA,ORDERNO,PRCPEIQT,PRCPID,QTY,REASON,VALUE,X,Y
- +2 SET ITEMDATA=$GET(^PRCP(445,PRCPINPT,1,ITEMDA,0))
- IF ITEMDATA=""
- QUIT
- +3 WRITE !!?3,"QTY ON-HAND (in ",$$UNIT^PRCPUX1(PRCPINPT,ITEMDA," per "),"): ",+$PIECE(ITEMDATA,"^",7)
- +4 WRITE !?10,"x",?16,"AVERAGE COST: ",$JUSTIFY(+$PIECE(ITEMDATA,"^",22),0,3)
- +5 WRITE !?10,"=",?13,"INVENTORY VALUE: ",$JUSTIFY(+$PIECE(ITEMDATA,"^",27),0,2),!
- +6 SET QTY=$$QTY^PRCPAWU0(-99999,99999)
- if QTY["^"
- QUIT
- +7 WRITE !
- SET VALUE=$$VALUE^PRCPAWU0(-9999999.99,9999999.99,"",0)
- if VALUE["^"
- QUIT
- +8 SET QTY=+QTY
- SET VALUE=+VALUE
- IF QTY=0
- IF VALUE=0
- QUIT
- +9 WRITE !
- SET REASON=$$REASON^PRCPAWU0("",1)
- if REASON["^"
- QUIT
- +10 SET ORDERNO=$$ORDERNO^PRCPUTRX(PRCPINPT)
- +11 KILL PRCPEIQT
- SET PRCPEIQT("QTY")=QTY
- SET PRCPEIQT("INVVAL")=VALUE
- SET PRCPEIQT("SELVAL")=0
- SET PRCPEIQT("REASON")="0:"_REASON
- SET PRCPEIQT("2237PO")=""
- +12 DO ITEM^PRCPUUIW(PRCPINPT,ITEMDA,"A",ORDERNO,.PRCPEIQT)
- +13 QUIT
- +14 ;
- +15 ;
- DUEIN(PRCPINPT,ITEMDA) ; change primary or secondary due-ins
- +1 NEW %,%H,D,D0,D1,DA,DD,DDC,DDH,DI,DIC,DIE,DIX,DIY,DIZ,DO,DQ,DR,DZ,ITEMDATA,PRCPTYPE,X,Y,Z
- +2 SET ITEMDATA=$GET(^PRCP(445,PRCPINPT,1,ITEMDA,0))
- IF ITEMDATA=""
- QUIT
- +3 SET PRCPTYPE=$PIECE(^PRCP(445,PRCPINPT,0),"^",3)
- +4 WRITE !!?3,"QTY DUE-IN (in ",$$UNIT^PRCPUX1(PRCPINPT,ITEMDA," per "),"): ",$$GETIN^PRCPUDUE(PRCPINPT,ITEMDA),!
- +5 if '$DATA(^PRCP(445,PRCPINPT,1,ITEMDA,7,0))
- SET ^(0)="^445.09P^^"
- +6 SET (DIC,DIE)="^PRCP(445,"_PRCPINPT_",1,"
- SET DA(1)=PRCPINPT
- SET DA=ITEMDA
- SET DR=$SELECT(PRCPTYPE="S":8.1,1:20)
- +7 DO ^DIE
- +8 IF PRCPTYPE="S"
- QUIT
- +9 SET (X,Y)=0
- FOR
- SET X=$ORDER(^PRCP(445,PRCPINPT,1,ITEMDA,7,X))
- if 'X
- QUIT
- SET Y=Y+$PIECE($GET(^(X,0)),"^",2)
- +10 SET X=Y-$$GETIN^PRCPUDUE(PRCPINPT,ITEMDA)
- IF X
- WRITE !?5,"...total DUE-IN QUANTITY adjusted (by: ",X,") to: ",Y
- DO SETIN^PRCPUDUE(PRCPINPT,ITEMDA,X)
- DO R^PRCPUREP
- +11 QUIT
- +12 ;
- +13 ;
- COSTEDIT(PRCPINPT,ITEMDA) ; edit last cost for invpt and item
- +1 NEW %,D,D0,DA,DI,DIC,DIE,DQ,DR,DZ,X,X1,Y,Y1
- CE1 SET DA(1)=PRCPINPT
- SET DA=ITEMDA
- SET (DIC,DIE)="^PRCP(445,"_PRCPINPT_",1,"
- SET DR="4.7LAST COST;"
- +1 DO ^DIE
- +2 SET X1=$PIECE(^PRCP(445,PRCPINPT,1,ITEMDA,0),"^",22)
- SET X=$PIECE(^PRCP(445,PRCPINPT,1,ITEMDA,0),"^",15)
- SET Y=X1*1.1
- SET Y1=X1/1.1
- +3 IF X>Y!(X<Y1)
- Begin DoDot:1
- +4 SET Y=""
- SET DIR(0)="Y"
- SET DIR("B")="YES"
- SET DIR("A")="Re-Edit Last Cost"
- +5 SET DIR("A",1)="** WARNING: Difference between last cost entered "
- +6 SET DIR("A",2)="and average cost ("_X1_") is more than 10% **"
- +7 DO ^DIR
- KILL DIR
- +8 IF Y=1
- SET Y="YES"
- +9 QUIT
- End DoDot:1
- +10 IF Y="YES"
- GOTO CE1
- +11 QUIT
