| 1 | PRCPOPP1 ;WISC/RFJ-case cart/instrument kit post utilities ;27 Sep 93
|
|---|
| 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 | EDIT ; edit items on list
|
|---|
| 8 | D FULL^VALM1
|
|---|
| 9 | S VALMBCK="R"
|
|---|
| 10 | N CCIKITEM,ITEMDA
|
|---|
| 11 | F W ! S CCIKITEM=+$$ITEMSEL("C") Q:'CCIKITEM D
|
|---|
| 12 | . F W ! S ITEMDA=+$$ITEMSEL("I") Q:'ITEMDA D
|
|---|
| 13 | . . D QTYRETRN
|
|---|
| 14 | D BUILD^PRCPOPPC
|
|---|
| 15 | Q
|
|---|
| 16 | ;
|
|---|
| 17 | ;
|
|---|
| 18 | QTYRETRN ; ask for quantity to return to primary
|
|---|
| 19 | N DIR,X,Y
|
|---|
| 20 | S X=$G(^TMP($J,"PRCPOPPC-ITEMS",CCIKITEM,ITEMDA))
|
|---|
| 21 | S DIR(0)="NA^0:"_$P(X,"^")_":0",DIR("A")=" QUANTITY TO RETURN: ",DIR("B")=$P(X,"^",2)
|
|---|
| 22 | S DIR("A",1)=" Quantity Ordered : "_$P(X,"^")
|
|---|
| 23 | S DIR("A",2)=" Quantity Returned: "_$P(X,"^",2)
|
|---|
| 24 | S DIR("A",3)=" Quantity to Post : "_($P(X,"^")-$P(X,"^",2))
|
|---|
| 25 | S DIR("A",4)="Enter the quantity of this item to return to the primary inventory point."
|
|---|
| 26 | W ! D ^DIR
|
|---|
| 27 | I +Y=Y S ^TMP($J,"PRCPOPPC-RETURN",CCIKITEM,ITEMDA)=+Y,$P(^TMP($J,"PRCPOPPC-ITEMS",CCIKITEM,ITEMDA),"^",2)=+Y
|
|---|
| 28 | Q
|
|---|
| 29 | ;
|
|---|
| 30 | ;
|
|---|
| 31 | ITEMSEL(V1) ; select items
|
|---|
| 32 | ; v1=C for cc or ik items; v1=I for non cc or ik items
|
|---|
| 33 | ; returns item number
|
|---|
| 34 | N %,DDH,DIC,DTOUT,DUOUT,PRCPSET,X,Y
|
|---|
| 35 | I V1="C" D
|
|---|
| 36 | . S DIC("S")="I $P(^(0),U,6)=""S"",$D(^TMP($J,""PRCPOPPC-ITEMS"",Y))",DIC("A")="Select CASE CART or INSTRUMENT KIT: "
|
|---|
| 37 | I V1="I" D
|
|---|
| 38 | . S DIC("S")="I $P(^(0),U,6)'=""S"",$D(^TMP($J,""PRCPOPPC-ITEMS"",CCIKITEM,Y))",DIC("A")=" Select ITEM: "
|
|---|
| 39 | S PRCPSET="I 1"
|
|---|
| 40 | S DIC="^PRC(441,",DIC(0)="QEAM" D ^DIC
|
|---|
| 41 | Q $S(Y<1:0,1:+Y)
|
|---|
| 42 | ;
|
|---|
| 43 | ;
|
|---|
| 44 | REMREUSE ; remove all reusable items from the list and post zero
|
|---|
| 45 | D FULL^VALM1
|
|---|
| 46 | S VALMBCK="R"
|
|---|
| 47 | N %,CCIKITEM,ITEMDA
|
|---|
| 48 | S XP="Do you want to remove ALL reusable items from the list and post ZERO"
|
|---|
| 49 | S XH="Enter 'YES' to remove all REUSABLE items from the list and post zero"
|
|---|
| 50 | S XH(1)="Enter 'NO' or '^' to leave the list as is and return to the main screen."
|
|---|
| 51 | W ! I $$YN^PRCPUYN(2)'=1 Q
|
|---|
| 52 | ; remove reusables from list
|
|---|
| 53 | S CCIKITEM=0 F S CCIKITEM=$O(^TMP($J,"PRCPOPPC-ITEMS",CCIKITEM)) Q:'CCIKITEM S ITEMDA=0 F S ITEMDA=$O(^TMP($J,"PRCPOPPC-ITEMS",CCIKITEM,ITEMDA)) Q:'ITEMDA D
|
|---|
| 54 | . I $$REUSABLE^PRCPU441(ITEMDA) K ^TMP($J,"PRCPOPPC-ITEMS",CCIKITEM,ITEMDA),^TMP($J,"PRCPOPPC-RETURN",CCIKITEM,ITEMDA) S ^TMP($J,"PRCPOPPC-NO",ITEMDA)=""
|
|---|
| 55 | D BUILD^PRCPOPPC
|
|---|
| 56 | Q
|
|---|
| 57 | ;
|
|---|
| 58 | ;
|
|---|
| 59 | REMCCIK ; remove cc or ik from list and post zero
|
|---|
| 60 | D FULL^VALM1
|
|---|
| 61 | S VALMBCK="R"
|
|---|
| 62 | N %,CCIKITEM,ITEMDA,PRCPFILE,TYPE
|
|---|
| 63 | W ! S CCIKITEM=+$$ITEMSEL("C") I 'CCIKITEM Q
|
|---|
| 64 | S PRCPFILE=$$FILENUMB^PRCPCUT1(CCIKITEM),TYPE=$S(PRCPFILE=445.7:"CASE CART",1:"INSTRUMENT KIT")
|
|---|
| 65 | S XP="Do you want to remove this "_TYPE_" from the list and post ZERO"
|
|---|
| 66 | S XH="Enter 'YES' to remove "_TYPE_" from the list and post ZERO"
|
|---|
| 67 | S XH(1)="Enter 'NO' or '^' to leave the list as is and return to the main screen."
|
|---|
| 68 | W ! I $$YN^PRCPUYN(2)'=1 Q
|
|---|
| 69 | ; remove cc or ik from list
|
|---|
| 70 | K ^TMP($J,"PRCPOPPC-ITEMS",CCIKITEM),^TMP($J,"PRCPOPPCCIK",CCIKITEM),^TMP($J,"PRCPOPPC-RETURN",CCIKITEM)
|
|---|
| 71 | S ^TMP($J,"PRCPOPPC-NO",CCIKITEM)=""
|
|---|
| 72 | D BUILD^PRCPOPPC
|
|---|
| 73 | Q
|
|---|
