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
|
---|