RMPREXR ;PHX/HNB ;REFRESH ITEM AMIS CODES ;08/22/96
;;3.0;PROSTHETICS;**12**;Feb 09, 1996
;check type of transaction, if X then repair, all other is new
Q
EN N BO,B1,B2,TYPE,ITM,NEW,REPAIR
S BO=0
F S BO=$O(^RMPR(660,"B",BO)) Q:(BO>RMPRDT2)!(BO'>0) D
.Q:BO<RMPRDT1
.;date range check complete
.;pick up mult records with same date
.S B1=0
.F S B1=$O(^RMPR(660,"B",BO,B1)) Q:B1'>0 D
..S B2=$G(^RMPR(660,B1,0))
..Q:B2=""
..S ITM=$P(B2,U,6),TYPE=$P(B2,U,4)
..Q:ITM=""
..Q:TYPE=""
..S NEW=$P(^RMPR(661,ITM,0),U,3),REPAIR=$P(^(0),U,4)
..I TYPE="X" S $P(^RMPR(660,B1,"AM"),U,5)=REPAIR,$P(^("AM"),U,9)="" Q
..S $P(^RMPR(660,B1,"AM"),U,9)=NEW,$P(^("AM"),U,5)=""
;END
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPREXR 702 printed Nov 22, 2024@17:44:37 Page 2
RMPREXR ;PHX/HNB ;REFRESH ITEM AMIS CODES ;08/22/96
+1 ;;3.0;PROSTHETICS;**12**;Feb 09, 1996
+2 ;check type of transaction, if X then repair, all other is new
+3 QUIT
EN NEW BO,B1,B2,TYPE,ITM,NEW,REPAIR
+1 SET BO=0
+2 FOR
SET BO=$ORDER(^RMPR(660,"B",BO))
if (BO>RMPRDT2)!(BO'>0)
QUIT
Begin DoDot:1
+3 if BO<RMPRDT1
QUIT
+4 ;date range check complete
+5 ;pick up mult records with same date
+6 SET B1=0
+7 FOR
SET B1=$ORDER(^RMPR(660,"B",BO,B1))
if B1'>0
QUIT
Begin DoDot:2
+8 SET B2=$GET(^RMPR(660,B1,0))
+9 if B2=""
QUIT
+10 SET ITM=$PIECE(B2,U,6)
SET TYPE=$PIECE(B2,U,4)
+11 if ITM=""
QUIT
+12 if TYPE=""
QUIT
+13 SET NEW=$PIECE(^RMPR(661,ITM,0),U,3)
SET REPAIR=$PIECE(^(0),U,4)
+14 IF TYPE="X"
SET $PIECE(^RMPR(660,B1,"AM"),U,5)=REPAIR
SET $PIECE(^("AM"),U,9)=""
QUIT
+15 SET $PIECE(^RMPR(660,B1,"AM"),U,9)=NEW
SET $PIECE(^("AM"),U,5)=""
End DoDot:2
End DoDot:1
+16 ;END
