| 1 | RMPRPIYV ;HINCIO/ODJ - PIP Data Entry - HCPCS;3/8/01 | 
|---|
| 2 | ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 | 
|---|
| 3 | Q | 
|---|
| 4 | ; | 
|---|
| 5 | ;***** HCPCS - Prompt for HCPCS code to TRANSFER | 
|---|
| 6 | ;              called by Transfer option RMPRPIYT | 
|---|
| 7 | ; | 
|---|
| 8 | ; Inputs: | 
|---|
| 9 | ;   RMPR5 - Location array (from 661.5) must contain... | 
|---|
| 10 | ;     RMPR5("IEN")     - ien of Location | 
|---|
| 11 | ;     RMPR5("STATION") - ien of location's Station | 
|---|
| 12 | ; | 
|---|
| 13 | ;   RMPR1("HCPCS") - (optional) Default HCPCS code | 
|---|
| 14 | ; | 
|---|
| 15 | ; Outputs: | 
|---|
| 16 | ;   RMPREXC - Exit condition | 
|---|
| 17 | ;   RMPR1   - array of HCPCS data fields from 661.1 | 
|---|
| 18 | ;     RMPR1("IEN")        - ien of HCPCS in 661.1 | 
|---|
| 19 | ;     RMPR1("HCPCS")      - HCPCS code | 
|---|
| 20 | ;     RMPR1("SHORT DESC") - HCPCS short description | 
|---|
| 21 | ; | 
|---|
| 22 | HCPCS(RMPR5,RMPR1,RMPREXC) ; | 
|---|
| 23 | N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DIRUT,DA,RMPRSTN,RMPRLCN,RMPR1N | 
|---|
| 24 | S DIR("A")="Enter HCPCS to Transfer: " | 
|---|
| 25 | S RMPRERR=0 | 
|---|
| 26 | S RMPREXC="" | 
|---|
| 27 | S RMPR1("HCPCS")=$G(RMPR1("HCPCS")) | 
|---|
| 28 | S RMPRSTN=RMPR5("STATION") | 
|---|
| 29 | S RMPRLCN=RMPR5("IEN") | 
|---|
| 30 | S DIR(0)="FOA" | 
|---|
| 31 | S DIR("?")="^D QM^RMPRPIYC" | 
|---|
| 32 | S DIR("??")="^D QM2^RMPRPIYC" | 
|---|
| 33 | HCPCS1 K RMPR1N D ^DIR | 
|---|
| 34 | I $D(DTOUT) S RMPREXC="T" G HCPCSX | 
|---|
| 35 | I $D(DIROUT) S RMPREXC="P" G HCPCSX | 
|---|
| 36 | I X=""!(X["^")!($D(DUOUT)) S RMPREXC="^" G HCPCSX | 
|---|
| 37 | D LIKE^RMPRPIYC(RMPRSTN,RMPRLCN,X,.RMPREXC,.RMPR1N) | 
|---|
| 38 | I RMPREXC'="" G HCPCS1 | 
|---|
| 39 | I $G(RMPR1N("IEN"))'="" G HCPCSU | 
|---|
| 40 | G HCPCS1 | 
|---|
| 41 | HCPCSU K RMPR1 M RMPR1=RMPR1N | 
|---|
| 42 | HCPCSX Q RMPRERR | 
|---|
| 43 | ; | 
|---|
| 44 | ; Help System (NOT IN USE) | 
|---|
| 45 | HLP N RMPRMAXL,RMPRH,RMPRL,RMPRERR,RMPR | 
|---|
| 46 | S RMPRMAXL=9 | 
|---|
| 47 | W ?4,"Answer with HCPCS" | 
|---|
| 48 | W !?3,"Choose from:" | 
|---|
| 49 | S RMPRL=0 | 
|---|
| 50 | S RMPRH="" | 
|---|
| 51 | F  S RMPRH=$O(^RMPR(661.7,"XSLHIDS",RMPR5("STATION IEN"),RMPR5("IEN"),RMPRH)) Q:RMPRH=""  D  Q:RMPRL'<RMPRMAXL | 
|---|
| 52 | . S RMPRL=RMPRL+1 | 
|---|
| 53 | . W !?3,RMPRH | 
|---|
| 54 | . S RMPR("HCPCS")=RMPRH,RMPRERR=$$HPACT^RMPRPIX1(.RMPR) | 
|---|
| 55 | . W ?26,RMPR("SHORT DESC") | 
|---|
| 56 | . Q | 
|---|
| 57 | Q | 
|---|