| 1 | PRCPAWU0 ;WISC/RFJ-adjustment utilities ;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 | ITEM() ; select item from tmp($j,"prcpawap","item",*itemnumber*) global
|
|---|
| 8 | N %,COUNT,ITEMDA,PRCPFLAG,X
|
|---|
| 9 | F D Q:ITEMDA'=""
|
|---|
| 10 | . W !," Select ITEM: "
|
|---|
| 11 | . R X:DTIME I '$T!(X["^")!(X="") S ITEMDA="^" Q
|
|---|
| 12 | . I $D(^TMP($J,"PRCPAWAP","ITEM",+X)) S ITEMDA=+X Q
|
|---|
| 13 | . S ITEMDA=""
|
|---|
| 14 | . W !,"Select the ITEM NUMBER from the list below:",!
|
|---|
| 15 | . S COUNT=0,X="" F S X=$O(^TMP($J,"PRCPAWAP","ITEM",X)) Q:X=""!($G(PRCPFLAG)) D
|
|---|
| 16 | . . W " ITEM NUMBER: ",X,?23,$E($$DESCR^PRCPUX1(PRCP("I"),+X),1,30),?58,"NSN: ",$$NSN^PRCPUX1(+X) S COUNT=COUNT+1
|
|---|
| 17 | . . I COUNT#20=0 D P^PRCPUREP S %="",$P(%," ",80)="" W $C(13),%
|
|---|
| 18 | . . W !
|
|---|
| 19 | Q ITEMDA
|
|---|
| 20 | ;
|
|---|
| 21 | ;
|
|---|
| 22 | VOUCHER() ; enter reference voucher number
|
|---|
| 23 | N DIR,X,Y
|
|---|
| 24 | S DIR(0)="FA^5:5",DIR("A")=" VOUCHER NUMBER: ",DIR("A",1)=" >> Enter DOCUMENT IDENTIFIER number. <<"
|
|---|
| 25 | D ^DIR
|
|---|
| 26 | Q Y
|
|---|
| 27 | ;
|
|---|
| 28 | ;
|
|---|
| 29 | QTY(LOW,HIGH) ; adjust quantity from low to high
|
|---|
| 30 | ; return qty, qty=^ for ^ entered
|
|---|
| 31 | N DIR,X,Y
|
|---|
| 32 | S DIR(0)="NA^"_LOW_":"_HIGH_":0",DIR("A")=" ADJUSTED QUANTITY: ",DIR("B")=0
|
|---|
| 33 | S DIR("A",1)=" >> Enter the adjusted quantity in the range "_LOW_" to "_HIGH_". <<"
|
|---|
| 34 | D ^DIR
|
|---|
| 35 | Q Y
|
|---|
| 36 | ;
|
|---|
| 37 | ;
|
|---|
| 38 | VALUE(LOW,HIGH,PROMPT,DEFAULT) ; adjust value from low to high
|
|---|
| 39 | ; ask in prompt with default value
|
|---|
| 40 | N DIR,X,Y
|
|---|
| 41 | S DIR(0)="NAO^"_LOW_":"_HIGH_":2",DIR("A")=" ADJUSTED TOTAL"_PROMPT_" VALUE: " S:DEFAULT'="" DIR("B")=DEFAULT
|
|---|
| 42 | S DIR("A",1)=" >> Enter the adjusted value in the range "_LOW_" to "_HIGH_". <<"
|
|---|
| 43 | D ^DIR
|
|---|
| 44 | Q Y
|
|---|
| 45 | ;
|
|---|
| 46 | ;
|
|---|
| 47 | REASON(DEFAULT) ; enter reason text
|
|---|
| 48 | N DIR,REASON,X,Y
|
|---|
| 49 | I DEFAULT="" S REASON=$G(^DISV(+$G(DUZ),"PRCPAWU0","REASON"))
|
|---|
| 50 | S DIR(0)="F^1:80",DIR("A")=" REASON TEXT",DIR("B")=$S(DEFAULT="":$G(REASON),1:DEFAULT)
|
|---|
| 51 | S DIR("A",1)=" >> Enter the reason text which will appear on the transaction register. <<"
|
|---|
| 52 | D ^DIR
|
|---|
| 53 | I DEFAULT="",Y'["^" S ^DISV(DUZ,"PRCPAWU0","REASON")=Y
|
|---|
| 54 | Q Y
|
|---|
