RMPREXR.m

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 ---RMPREXR   702     printed  Apr 09, 2024@21:35:20                                                                                                                                                                                                      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