source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPAWU0.m@ 1582

Last change on this file since 1582 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1PRCPAWU0 ;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 ;
7ITEM() ; 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 ;
22VOUCHER() ; 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 ;
29QTY(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 ;
38VALUE(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 ;
47REASON(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
Note: See TracBrowser for help on using the repository browser.