source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRN6S.m@ 1361

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

initial load of WorldVistAEHR

File size: 1.9 KB
RevLine 
[613]1RMPRN6S ;HINES IOFO/HNC ;NPPD SORT LOGIC - 11/10/00
2 ;;3.0;PROSTHETICS;**51,90**;Feb 09, 1996
3 ;
4 ;
5DISP ;display info before dir call
6 W !
7 W !,?6,"Sort Options"
8 W !,?6,"------------"
9 W !,?6,"2 or 5 = USED INVENTORY ONLY (NEW REPORT)"
10 W !!,?6,"1 or 4 = NEW ITEM COSTS, USED INVENTORY (VA) COST AS ZERO,"
11 W !,?6," (PREVIOUS BRIEF/DETAILED NPPD REPORT)"
12 W !!,?6,"3 or 6 = NEW AND USED COST, BOTH DOLLAR AMOUNTS TOTALED (NEW REPORT)"
13 Q
14SORTUSED ;sort only recovered items cost from PIP
15 ;
16 S TYPE=$P(^RMPR(660,RD,0),U,4)
17 S TY=$S(TYPE="X":2,TYPE=5:2,TYPE="I":1,1:3)
18 S SOURCE=$P(^RMPR(660,RD,0),U,14)
19 ;only va, or used, recovered items
20 Q:SOURCE'="V"
21 ;stock issue null (not PIP) and source VA (used)
22 I $P(^RMPR(660,RD,1),U,5)="" Q
23 S CATEGRY=$P($G(^RMPR(660,RD,"AM")),U,3),SPEC=$P($G(^("AM")),U,4),GN=$P(^("AMS"),U,1)
24 S COST=$P(^RMPR(660,RD,0),U,16)
25 ;form
26 ;S FORM=$P(^RMPR(660,RD,0),U,13)
27 ;I (FORM=4)!(FORM=15) S COST=0,SOURCE="V"
28 S QTY=$P(^RMPR(660,RD,0),U,7)
29 S B1=RD
30 S ^TMP($J,CODE,RD)=COST
31 I TY=2 D REP^RMPRN6
32 I TY'=2 D NEW^RMPRN6
33 Q
34 ;
35 ;
36 ;
37SORTBOTH ;sort both new and used recovered items cost
38 S TYPE=$P(^RMPR(660,RD,0),U,4)
39 S TY=$S(TYPE="X":2,TYPE=5:2,TYPE="I":1,1:3)
40 S SOURCE=$P(^RMPR(660,RD,0),U,14)
41 ;
42 S CATEGRY=$P($G(^RMPR(660,RD,"AM")),U,3),SPEC=$P($G(^("AM")),U,4),GN=$P(^("AMS"),U,1)
43 S COST=$P(^RMPR(660,RD,0),U,16)
44 ;stock issue source VA, used cost calculation is ACTUAL FOR BOTH
45 ;I $P(^RMPR(660,RD,1),U,5)'=""&(SOURCE["V") S COST=0
46 ;form
47 S FORM=$P(^RMPR(660,RD,0),U,13)
48 I (FORM=4)!(FORM=15) S COST=0,SOURCE="V"
49 S QTY=$P(^RMPR(660,RD,0),U,7)
50 S B1=RD
51 S ^TMP($J,CODE,RD)=COST
52 I TY=2 D REP^RMPRN6
53 I TY'=2 D NEW^RMPRN6
54 Q
55HDR(X) ;display nppd sort header new or used
56 I X=2!(X=5) S X="USED INVENTORY ONLY"
57 I X=1!(X=4) S X="NEW ITEM COSTS, USED INVENTORY (VA) COST AS ZERO"
58 I X=3!(X=6) S X="NEW AND USED COST, BOTH DOLLAR AMOUNTS TOTALED"
59 Q X
60END ;
Note: See TracBrowser for help on using the repository browser.