| [613] | 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
|
|---|
