| [613] | 1 | PRCPWPL2 ;WISC/RFJ/DGL-whse post issue book (cancel);13 Jan 94 [1/13/99 11:16am]
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | CANCEL ; cancel item
|
|---|
| 8 | D FULL^VALM1
|
|---|
| 9 | S VALMBCK="R"
|
|---|
| 10 | N DATA,LINEDA,STATUS,X,XP
|
|---|
| 11 | K X S X(1)="This option will allow you to CANCEL a line item on the issue book. Once a line item is cancelled, the due-ins and due-outs will be decreased by the outstanding quantity."
|
|---|
| 12 | D DISPLAY^PRCPUX2(5,75,.X)
|
|---|
| 13 | F W ! S LINEDA=$$LINEITEM^PRCPWPL0 Q:LINEDA<1 D
|
|---|
| 14 | . S DATA=$G(^PRCS(410,PRCPDA,"IT",LINEDA,0)) I DATA="" W !,"CANNOT FIND LINE ITEM." Q
|
|---|
| 15 | . S STATUS=$P(DATA,"^",14),XP=""
|
|---|
| 16 | . I STATUS'="" W !,"ITEM IS ALREADY CANCELLED",$S(STATUS["S":" AND SUBSTITUTED WITH LINE #(S): "_$P(STATUS,",",2,99),1:"") Q
|
|---|
| 17 | . I $P(DATA,"^",12)>$P(DATA,"^",13) S XP="Primary will NOT be able to receive this item. "
|
|---|
| 18 | . S XP=XP_"ARE YOU SURE YOU WANT TO CANCEL THIS ITEM",XH="Enter YES to CANCEL this line item."
|
|---|
| 19 | . W ! I $$YN^PRCPUYN(1)'=1 Q
|
|---|
| 20 | . D CANCELIT
|
|---|
| 21 | D REBUILD^PRCPWPLB
|
|---|
| 22 | Q
|
|---|
| 23 | ;
|
|---|
| 24 | ;
|
|---|
| 25 | CANCELIT ; cancel the item without asking
|
|---|
| 26 | S ^TMP($J,"PRCPWPLMPOST",LINEDA)=0
|
|---|
| 27 | N %,DATA,ITEMDA,QTYOUT
|
|---|
| 28 | S DATA=$G(^PRCS(410,PRCPDA,"IT",LINEDA,0)) I DATA="" Q
|
|---|
| 29 | S ITEMDA=+$P(DATA,"^",5)
|
|---|
| 30 | S QTYOUT=$P(DATA,"^",2)-$P(DATA,"^",12) I QTYOUT<0 S QTYOUT=0
|
|---|
| 31 | I $P(DATA,"^",14)'["C" S $P(^PRCS(410,PRCPDA,"IT",LINEDA,0),"^",14)="C"_$P(DATA,"^",14)
|
|---|
| 32 | I $D(^PRCP(445,PRCPINPT,1,ITEMDA,0)) W !?5,"... decrementing due-outs@warehouse by ",QTYOUT D SETOUT^PRCPUDUE(PRCPINPT,ITEMDA,-QTYOUT)
|
|---|
| 33 | I $D(^PRCP(445,PRCPPRIM,1,ITEMDA,7,PRCPDA,0)) D
|
|---|
| 34 | . W !?5,"... decrementing due-ins @primary by ",QTYOUT
|
|---|
| 35 | . I QTYOUT>0 D SETIN^PRCPUDUE(PRCPPRIM,ITEMDA,-QTYOUT)
|
|---|
| 36 | . S DIK="^PRCP(445,"_PRCPPRIM_",1,"_ITEMDA_",7,"
|
|---|
| 37 | . S DA=PRCPDA,DA(1)=ITEMDA,DA(2)=PRCPPRIM
|
|---|
| 38 | . D ^DIK
|
|---|
| 39 | W !,"*** Line item HAS BEEN cancelled ***"
|
|---|
| 40 | Q
|
|---|
| 41 | ;
|
|---|
| 42 | ;
|
|---|
| 43 | FINAL ; make issue book a final
|
|---|
| 44 | D FULL^VALM1
|
|---|
| 45 | S VALMBCK="R"
|
|---|
| 46 | S PRCPFINL=$S($$FINALASK=1:1,1:0)
|
|---|
| 47 | D HDR^PRCPWPLM
|
|---|
| 48 | Q
|
|---|
| 49 | ;
|
|---|
| 50 | ;
|
|---|
| 51 | FINALASK() ; ask to make issue book a final
|
|---|
| 52 | N X
|
|---|
| 53 | K X S X(1)="You have the option to make this issue book a FINAL. If you make the issue book a FINAL, all due-outs and due-ins will be cancelled and you will no longer be able to post the issue book."
|
|---|
| 54 | D DISPLAY^PRCPUX2(5,75,.X)
|
|---|
| 55 | S XP="Do you want to make this issue book a FINAL",XH="Enter YES to make this issue book a final."
|
|---|
| 56 | Q $$YN^PRCPUYN(2)
|
|---|
