| 1 | PRCPAWI0 ;WISC/RFJ-adjust inventory level - issue 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 1 issue book adjustment
|
|---|
| 8 | ISUEBOOK ; issue book adjustment
|
|---|
| 9 | N PRCPDA,PRCPPVNO
|
|---|
| 10 | S PRCPPVNO=+$O(^PRC(440,"AC","S",0))_";PRC(440," I '$D(^PRC(440,+PRCPPVNO,0)) W !!,"THERE IS NOT A VENDOR IN THE VENDOR FILE (#440) DESIGNATED AS A SUPPLY WHSE." Q
|
|---|
| 11 | F S PRCPDA=$$SELECTIB^PRCPWPLM(0) Q:PRCPDA'>0 D
|
|---|
| 12 | . L +^PRCS(410,PRCPDA):5 I '$T D SHOWWHO^PRCPULOC(410,PRCPDA,0) Q
|
|---|
| 13 | . D ADD^PRCPULOC(410,PRCPDA,0,"Adjust Issue Book")
|
|---|
| 14 | . N %,DISTRPT,OTHERPT,TRANNO,VOUCHER
|
|---|
| 15 | . S TRANNO=$P($G(^PRCS(410,PRCPDA,0)),"^")
|
|---|
| 16 | . I TRANNO="" W !,"CANNOT FIND THE TRANSACTION NUMBER FOR THIS ISSUE BOOK." D UNLOCK Q
|
|---|
| 17 | . S %=$G(^PRCS(410,PRCPDA,445))
|
|---|
| 18 | . I '$P(%,"^",2) W !,"THIS ISSUE BOOK HAS NOT BEEN POSTED (NO FMS LINE NUMBER) AND CANNOT BE ADJUSTED." D UNLOCK Q
|
|---|
| 19 | . S VOUCHER=$P(%,"^")
|
|---|
| 20 | . I VOUCHER="" W !,"THIS ISSUE BOOK DOES NOT HAVE A REFERENCE VOUCHER NUMBER AND CANNOT BE ADJUSTED." D UNLOCK Q
|
|---|
| 21 | . W !!,">> Reference Voucher Number: ",VOUCHER
|
|---|
| 22 | . S (DISTRPT,OTHERPT)=+$P(^PRCS(410,PRCPDA,0),"^",6)
|
|---|
| 23 | . I DISTRPT D
|
|---|
| 24 | . . W !!,">> Distribution to: ",$$INVNAME^PRCPUX1(DISTRPT)," inventory point."
|
|---|
| 25 | . . S %=$G(^PRCP(445,DISTRPT,0))
|
|---|
| 26 | . . I $P(%,"^",2)'="Y" W !,"NOTE: Primary is NOT keeping a PERPETUAL INVENTORY." S DISTRPT=0
|
|---|
| 27 | . . I $P(%,"^",6)'="Y" W !,"NOTE: Primary is NOT keeping a DETAILED TRANSACTION REGISTER." S DISTRPT=0
|
|---|
| 28 | . . I $P(%,"^",16)="N" W !,"NOTE: Primary set up so it will NOT be updated by the warehouse." S DISTRPT=0
|
|---|
| 29 | . . I 'DISTRPT W !,">> PRIMARY inventory point will NOT be updated."
|
|---|
| 30 | . ; get line adjustments
|
|---|
| 31 | . D LINEADJ
|
|---|
| 32 | . I '$O(^TMP($J,"PRCPAWI0","PROCESS",0)) W !!?10,">> NO LINE ITEMS HAVE BEEN SELECTED <<" D UNLOCK Q
|
|---|
| 33 | . ; get whse and buyer fcp data
|
|---|
| 34 | . N PRCPPBFY,PRCPPFCP,PRCPPSTA,PRCPWBFY,PRCPWFCP,PRCPWSTA
|
|---|
| 35 | . D IVDATA^PRCPSFIU(PRCPDA,PRCP("I"))
|
|---|
| 36 | . S XP="READY TO PROCESS ISSUE BOOK ADJUSTMENTS",XH="Enter YES to PROCESS the ISSUE BOOK adjustments, NO to exit."
|
|---|
| 37 | . W !! I $$YN^PRCPUYN(1)'=1 D UNLOCK Q
|
|---|
| 38 | . D ISUECONT^PRCPAWI1
|
|---|
| 39 | . D UNLOCK
|
|---|
| 40 | ;
|
|---|
| 41 | Q K ^TMP($J,"PRCPAWI0")
|
|---|
| 42 | Q
|
|---|
| 43 | ;
|
|---|
| 44 | ;
|
|---|
| 45 | UNLOCK ; unlock issue book lock
|
|---|
| 46 | D CLEAR^PRCPULOC(410,PRCPDA,0)
|
|---|
| 47 | L -^PRCS(410,PRCPDA)
|
|---|
| 48 | Q
|
|---|
| 49 | ;
|
|---|
| 50 | ;
|
|---|
| 51 | LINEITEM() ; select line item
|
|---|
| 52 | N DA,DIC,X,Y
|
|---|
| 53 | S DIC="^PRCS(410,"_PRCPDA_",""IT"",",DA(1)=PRCPDA,DIC(0)="QEAMZ",DIC("A")="Select LINE ITEM Number: "
|
|---|
| 54 | S DIC("W")="S %=$G(^PRCS(410,PRCPDA,""IT"",Y,445)) W ?7,""IM#: "",$P(^PRCS(410,PRCPDA,""IT"",Y,0),U,5),?20,"" QTY POSTED: ""_+$P(%,U,3),?40,"" INV VALUE: "",$J(+$P(%,U,4),0,2),?60,"" SELL VALUE: "",$J(+$P(%,U,5),0,2)"
|
|---|
| 55 | D ^DIC
|
|---|
| 56 | Q +Y
|
|---|
| 57 | ;
|
|---|
| 58 | ;
|
|---|
| 59 | LINEADJ ; enter line adjustment
|
|---|
| 60 | N INVVALUE,ITEMDA,ITEMDATA,LINEDA,LINEDATA,POSTDATA,QTY,REASON,SELVALUE
|
|---|
| 61 | K ^TMP($J,"PRCPAWI0")
|
|---|
| 62 | F W ! S LINEDA=$$LINEITEM Q:LINEDA'>0 D
|
|---|
| 63 | . S LINEDATA=$G(^PRCS(410,PRCPDA,"IT",LINEDA,0)),ITEMDA=+$P(LINEDATA,"^",5) I 'ITEMDA W !,"MISSING ITEM MASTER NUMBER." Q
|
|---|
| 64 | . D SHOWDATA^PRCPAWA0(PRCP("I"),ITEMDA)
|
|---|
| 65 | . W !!,"======================= I S S U E B O O K D A T A ======================="
|
|---|
| 66 | . S POSTDATA=$G(^PRCS(410,PRCPDA,"IT",LINEDA,445))
|
|---|
| 67 | . W !?5,"QUANTITY ORDERED: ",+$P(LINEDATA,"^",2)
|
|---|
| 68 | . W !?5,"QUANTITY POSTED : ",+$P(POSTDATA,"^",3)
|
|---|
| 69 | . W !?5,"INVENTORY VALUE : ",$J(+$P(POSTDATA,"^",4),0,2)
|
|---|
| 70 | . W !?5,"SELLING VALUE : ",$J(+$P(POSTDATA,"^",5),0,2),!
|
|---|
| 71 | . I $P(POSTDATA,"^")=""!('$P(POSTDATA,"^",3)&('$P(POSTDATA,"^",4))&('$P(POSTDATA,"^",5))) W !,"THIS LINE ITEM HAS NOT BEEN POSTED AND CANNOT BE ADJUSTED." Q
|
|---|
| 72 | . ; enter adjustment
|
|---|
| 73 | . S ITEMDATA=$G(^PRCP(445,PRCP("I"),1,ITEMDA,0)) I ITEMDATA="" W !,"THIS ITEM IS NOT STORED IN THE INVENTORY POINT." Q
|
|---|
| 74 | . ; line item already selected
|
|---|
| 75 | . I $D(^TMP($J,"PRCPAWI0","PROCESS",LINEDA)) 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
|
|---|
| 76 | . K ^TMP($J,"PRCPAWI0","PROCESS",LINEDA)
|
|---|
| 77 | . W !!,"**************** E N T E R A D J U S T M E N T D A T A ****************",!
|
|---|
| 78 | . S QTY=$$QTY^PRCPAWU0(-$P(POSTDATA,"^",3),0) I QTY["^" Q
|
|---|
| 79 | . S INVVALUE=$$VALUE^PRCPAWU0(-$P(POSTDATA,"^",4),99999.99," ISSUE BOOK INVENTORY","") I INVVALUE["^" Q
|
|---|
| 80 | . S SELVALUE=$$VALUE^PRCPAWU0(-$P(POSTDATA,"^",5),99999.99," ISSUE BOOK SELLING","") I SELVALUE["^" Q
|
|---|
| 81 | . I 'QTY,'INVVALUE,'SELVALUE W !!?10,">> EITHER QUANTITY OR VALUE NEEDS TO BE ENTERED FOR AN ADJUSTMENT <<" Q
|
|---|
| 82 | . W ! S REASON=$$REASON^PRCPAWU0("ISSUE BOOK adjustment") I REASON["^" Q
|
|---|
| 83 | . S ^TMP($J,"PRCPAWI0","PROCESS",LINEDA)=QTY_"^"_SELVALUE_"^"_INVVALUE_"^^^"_REASON_"^"_ITEMDA
|
|---|
| 84 | Q
|
|---|
