RMPRU99.m

RMPRU99 ;HINCIO/HNC - HISTORICAL ITEM TRIGGER; 9/28/04 12:27pm

 ;;3.0;PROSTHETICS;**99**,FEB 09,1996

EN ;

 ;X=ien 661, DA=ien 660

 N RMPRITE,RMPR441

 S RMPR441=$P($G(^RMPR(661,X,0)),U,1)

 I RMPR441="" S X="" Q

 S RMPRITE=$P($G(^PRC(441,RMPR441,0)),U,2)

 S X=RMPRITE

 Q

DEL ;

 Q

XREF ;

 W !!,"Setting Cross Reference..."

 S DIK="^RMPR(660,",DIK(1)="4" D ENALL^DIK

 ;END

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---RMPRU99   385     printed  Dec 13, 2024@02:37:58                                                                                                                                                                                                      Page 2

RMPRU99   ;HINCIO/HNC - HISTORICAL ITEM TRIGGER; 9/28/04 12:27pm

 +1       ;;3.0;PROSTHETICS;**99**,FEB 09,1996

EN        ;

 +1       ;X=ien 661, DA=ien 660

 +2        NEW RMPRITE,RMPR441

 +3        SET RMPR441=$PIECE($GET(^RMPR(661,X,0)),U,1)

 +4        IF RMPR441=""

               SET X=""

               QUIT 

 +5        SET RMPRITE=$PIECE($GET(^PRC(441,RMPR441,0)),U,2)

 +6        SET X=RMPRITE

 +7        QUIT 

DEL       ;

 +1        QUIT 

XREF      ;

 +1        WRITE !!,"Setting Cross Reference..."

 +2        SET DIK="^RMPR(660,"

           SET DIK(1)="4"

           DO ENALL^DIK

 +3       ;END