| [613] | 1 | RMPRPIYX ;HINCIO/ODJ - PIP Data Entry - HCPCS Item;3/8/01
|
|---|
| 2 | ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
|
|---|
| 3 | Q
|
|---|
| 4 | ;
|
|---|
| 5 | ;***** Prompt for HCPCS Item - called by Transfer option
|
|---|
| 6 | ; restrict choice to Location and HCPC
|
|---|
| 7 | ITEM(RMPRSTN,RMPRLCN,RMPRHCPC,RMPR11,RMPR4,RMPREXC) ;
|
|---|
| 8 | N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DA,RMPRSRC,RMPRYN
|
|---|
| 9 | S RMPRERR=0
|
|---|
| 10 | S RMPREXC=""
|
|---|
| 11 | I $G(RMPRSTN)="" S RMPRERR=1 G ITEMX
|
|---|
| 12 | I $G(RMPRLCN)="" S RMPRERR=2 G ITEMX
|
|---|
| 13 | I $G(RMPRHCPC)="" S RMPRERR=3 G ITEMX
|
|---|
| 14 | K RMPR11,RMPR4
|
|---|
| 15 | S DIR(0)="FOA^1:50"
|
|---|
| 16 | S DIR("A")="Enter Item to transfer: "
|
|---|
| 17 | S DIR("?")="^D QM^RMPRPIY8"
|
|---|
| 18 | S DIR("??")="^D QQM^RMPRPIY8"
|
|---|
| 19 | ITEMA1 D ^DIR
|
|---|
| 20 | I $D(DTOUT) S RMPREXC="T" G ITEMX
|
|---|
| 21 | I $D(DIROUT) S RMPREXC="P" G ITEMX
|
|---|
| 22 | I X=""!(X["^")!$D(DUOUT) S RMPREXC="^" G ITEMX
|
|---|
| 23 | D LIKE^RMPRPIY8(RMPRSTN,RMPRLCN,RMPRHCPC,X,.RMPREXC,.RMPR11,.RMPR4)
|
|---|
| 24 | I RMPREXC="T" G ITEMX
|
|---|
| 25 | I RMPREXC="P" G ITEMX
|
|---|
| 26 | I RMPREXC="^" G ITEMA1
|
|---|
| 27 | I RMPR4("IEN")="" D G ITEMA1
|
|---|
| 28 | . W !,"Cannot locate ITEM with this sequence NUMBER"
|
|---|
| 29 | . Q
|
|---|
| 30 | W " ",RMPR11("HCPCS-ITEM")," ",RMPR11("DESCRIPTION")
|
|---|
| 31 | D OK^RMPRPIY7(.RMPRYN,.RMPREXC)
|
|---|
| 32 | I RMPRYN'="Y" G ITEMA1
|
|---|
| 33 | G ITEMX
|
|---|
| 34 | ITEMX Q RMPRERR
|
|---|
