PRCPAWA0 ;WISC/RFJ-adjust whse inventory point ;11 Mar 94
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
D ^PRCPUSEL Q:'$D(PRCP("I")) I PRCP("DPTYPE")'="W" W !,"ONLY THE WAREHOUSE CAN USE THIS OPTION." Q
I $$CHECK^PRCPCUT1(PRCP("I")) Q
N %,%H,%I,D,DI,DISYS,DQ,TYPE,X,Y
S X="" W ! D ESIG^PRCUESIG(DUZ,.X) I X'>0 Q
S DIR(0)="SO^1:Issue Book Adjustment;2:Non-Issuable or Issuable Adjustment;3:Other (GIP and FMS) Adjustment;"_$S($$KEY^PRCPUREP("PRCPW MGRKEY",DUZ):"4:Supply Only (GIP) Adjustment;",1:""),DIR("A")="Select TYPE of ADJUSTMENT"
W ! D ^DIR K DIR I Y'=1,Y'=2,Y'=3,Y'=4 Q
S TYPE=Y,IOP="HOME" D ^%ZIS K IOP
I TYPE=1 D ISUEBOOK^PRCPAWI0 Q
I TYPE=2 D NONISSUE^PRCPAWN0 Q
I TYPE=3 D OTHER^PRCPAWO0
I TYPE=4 D SUPPLY^PRCPAWS0
Q
;
;
SHOWDATA(INVPT,ITEMDA) ; show inventory item data
S ITEMDATA=$G(^PRCP(445,INVPT,1,ITEMDA,0)) I ITEMDATA="" W !,"ITEM IS NOT STORED IN THE INVENTORY POINT." Q
W !!,"===================== C U R R E N T I T E M D A T A ====================="
W !,"ITEM NUMBER: ",ITEMDA,?23,$E($$DESCR^PRCPUX1(INVPT,ITEMDA),1,30),?58,"NSN: ",$$NSN^PRCPUX1(ITEMDA)
W !?5,"UNIT/ISSUE : ",$$UNIT^PRCPUX1(INVPT,ITEMDA,"/")
W !?5,"AVERAGE COST : ",$J(+$P(ITEMDATA,"^",22),0,2)
W !?5,"LAST COST : ",$J(+$P(ITEMDATA,"^",15),0,2)
W !
W !?5,"TOTAL VALUE : ",$J(+$P(ITEMDATA,"^",27),0,2)
W !?5,"QTY ON-HAND : ",$P(ITEMDATA,"^",7)
W !?5,"QTY NON-ISSUABLE: ",$P(ITEMDATA,"^",19)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPAWA0 1535 printed Dec 13, 2024@02:12:48 Page 2
PRCPAWA0 ;WISC/RFJ-adjust whse inventory point ;11 Mar 94
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 DO ^PRCPUSEL
if '$DATA(PRCP("I"))
QUIT
IF PRCP("DPTYPE")'="W"
WRITE !,"ONLY THE WAREHOUSE CAN USE THIS OPTION."
QUIT
+4 IF $$CHECK^PRCPCUT1(PRCP("I"))
QUIT
+5 NEW %,%H,%I,D,DI,DISYS,DQ,TYPE,X,Y
+6 SET X=""
WRITE !
DO ESIG^PRCUESIG(DUZ,.X)
IF X'>0
QUIT
+7 SET DIR(0)="SO^1:Issue Book Adjustment;2:Non-Issuable or Issuable Adjustment;3:Other (GIP and FMS) Adjustment;"_$SELECT($$KEY^PRCPUREP("PRCPW MGRKEY",DUZ):"4:Supply Only (GIP) Adjustment;",1:"")
SET DIR("A")="Select TYPE of ADJUSTMENT"
+8 WRITE !
DO ^DIR
KILL DIR
IF Y'=1
IF Y'=2
IF Y'=3
IF Y'=4
QUIT
+9 SET TYPE=Y
SET IOP="HOME"
DO ^%ZIS
KILL IOP
+10 IF TYPE=1
DO ISUEBOOK^PRCPAWI0
QUIT
+11 IF TYPE=2
DO NONISSUE^PRCPAWN0
QUIT
+12 IF TYPE=3
DO OTHER^PRCPAWO0
+13 IF TYPE=4
DO SUPPLY^PRCPAWS0
+14 QUIT
+15 ;
+16 ;
SHOWDATA(INVPT,ITEMDA) ; show inventory item data
+1 SET ITEMDATA=$GET(^PRCP(445,INVPT,1,ITEMDA,0))
IF ITEMDATA=""
WRITE !,"ITEM IS NOT STORED IN THE INVENTORY POINT."
QUIT
+2 WRITE !!,"===================== C U R R E N T I T E M D A T A ====================="
+3 WRITE !,"ITEM NUMBER: ",ITEMDA,?23,$EXTRACT($$DESCR^PRCPUX1(INVPT,ITEMDA),1,30),?58,"NSN: ",$$NSN^PRCPUX1(ITEMDA)
+4 WRITE !?5,"UNIT/ISSUE : ",$$UNIT^PRCPUX1(INVPT,ITEMDA,"/")
+5 WRITE !?5,"AVERAGE COST : ",$JUSTIFY(+$PIECE(ITEMDATA,"^",22),0,2)
+6 WRITE !?5,"LAST COST : ",$JUSTIFY(+$PIECE(ITEMDATA,"^",15),0,2)
+7 WRITE !
+8 WRITE !?5,"TOTAL VALUE : ",$JUSTIFY(+$PIECE(ITEMDATA,"^",27),0,2)
+9 WRITE !?5,"QTY ON-HAND : ",$PIECE(ITEMDATA,"^",7)
+10 WRITE !?5,"QTY NON-ISSUABLE: ",$PIECE(ITEMDATA,"^",19)
+11 QUIT
