- 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 Feb 18, 2025@23:39:11 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