1 | RMPREXR ;PHX/HNB ;REFRESH ITEM AMIS CODES ;08/22/96
|
---|
2 | ;;3.0;PROSTHETICS;**12**;Feb 09, 1996
|
---|
3 | ;check type of transaction, if X then repair, all other is new
|
---|
4 | Q
|
---|
5 | EN N BO,B1,B2,TYPE,ITM,NEW,REPAIR
|
---|
6 | S BO=0
|
---|
7 | F S BO=$O(^RMPR(660,"B",BO)) Q:(BO>RMPRDT2)!(BO'>0) D
|
---|
8 | .Q:BO<RMPRDT1
|
---|
9 | .;date range check complete
|
---|
10 | .;pick up mult records with same date
|
---|
11 | .S B1=0
|
---|
12 | .F S B1=$O(^RMPR(660,"B",BO,B1)) Q:B1'>0 D
|
---|
13 | ..S B2=$G(^RMPR(660,B1,0))
|
---|
14 | ..Q:B2=""
|
---|
15 | ..S ITM=$P(B2,U,6),TYPE=$P(B2,U,4)
|
---|
16 | ..Q:ITM=""
|
---|
17 | ..Q:TYPE=""
|
---|
18 | ..S NEW=$P(^RMPR(661,ITM,0),U,3),REPAIR=$P(^(0),U,4)
|
---|
19 | ..I TYPE="X" S $P(^RMPR(660,B1,"AM"),U,5)=REPAIR,$P(^("AM"),U,9)="" Q
|
---|
20 | ..S $P(^RMPR(660,B1,"AM"),U,9)=NEW,$P(^("AM"),U,5)=""
|
---|
21 | ;END
|
---|