RMPRPIYX ;HINCIO/ODJ - PIP Data Entry - HCPCS Item;3/8/01
 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
 Q
 ;
 ;***** Prompt for HCPCS Item - called by Transfer option
 ;      restrict choice to Location and HCPC
ITEM(RMPRSTN,RMPRLCN,RMPRHCPC,RMPR11,RMPR4,RMPREXC) ;
 N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DA,RMPRSRC,RMPRYN
 S RMPRERR=0
 S RMPREXC=""
 I $G(RMPRSTN)="" S RMPRERR=1 G ITEMX
 I $G(RMPRLCN)="" S RMPRERR=2 G ITEMX
 I $G(RMPRHCPC)="" S RMPRERR=3 G ITEMX
 K RMPR11,RMPR4
 S DIR(0)="FOA^1:50"
 S DIR("A")="Enter Item to transfer: "
 S DIR("?")="^D QM^RMPRPIY8"
 S DIR("??")="^D QQM^RMPRPIY8"
ITEMA1 D ^DIR
 I $D(DTOUT) S RMPREXC="T" G ITEMX
 I $D(DIROUT) S RMPREXC="P" G ITEMX
 I X=""!(X["^")!$D(DUOUT) S RMPREXC="^" G ITEMX
 D LIKE^RMPRPIY8(RMPRSTN,RMPRLCN,RMPRHCPC,X,.RMPREXC,.RMPR11,.RMPR4)
 I RMPREXC="T" G ITEMX
 I RMPREXC="P" G ITEMX
 I RMPREXC="^" G ITEMA1
 I RMPR4("IEN")="" D  G ITEMA1
 . W !,"Cannot locate ITEM with this sequence NUMBER"
 . Q
 W "  ",RMPR11("HCPCS-ITEM"),"  ",RMPR11("DESCRIPTION")
 D OK^RMPRPIY7(.RMPRYN,.RMPREXC)
 I RMPRYN'="Y" G ITEMA1
 G ITEMX
ITEMX Q RMPRERR