source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIYX.m@ 1765

Last change on this file since 1765 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.1 KB
Line 
1RMPRPIYX ;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
7ITEM(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"
19ITEMA1 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
34ITEMX Q RMPRERR
Note: See TracBrowser for help on using the repository browser.