1 | RMPRPIUI ;HINCIO/ODJ - CONVERT OLD PIP TO NEW PIP ;3/8/05 11:46
|
---|
2 | ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
|
---|
3 | ; DBIA #10090 - Read Access to entire file #4.
|
---|
4 | Q
|
---|
5 | ;
|
---|
6 | ;***** CONV - Convert Item records in 661.3 to 661.11
|
---|
7 | ; In the current PIP file design a HCPC Item is held as
|
---|
8 | ; free text in the form HCPCS-ITEM where HCPCS is the
|
---|
9 | ; HCPCS code (.01 field in 661.1 eg E0111) and ITEM is
|
---|
10 | ; the ien (ptr) to the item held on the ^RMPR(661.3,,3,)
|
---|
11 | ; multiple.
|
---|
12 | ; In the new design ITEM will be a number and not a pointer.
|
---|
13 | ; In this first pass through HCPCS Items the ITEM number
|
---|
14 | ; will be the same as ITEM ien for all commercial items.
|
---|
15 | ; Non-commercial items will have a different ITEM number
|
---|
16 | ; from their ITEM ien only where commercial and
|
---|
17 | ; non-commercial items have used the same HCPCS-ITEM code.
|
---|
18 | ; Non-commercial items will be ignored on this pass.
|
---|
19 | ; Any item whose Source field is not V
|
---|
20 | ; is assumed commercial.
|
---|
21 | ;
|
---|
22 | CONV N RMPRHIEN,RMPRIIEN,RMPRHREC,RMPRIREC,RMPRHCPC,RMPRHIT,RMPRGBL
|
---|
23 | N RMPR1,RMPR2,RMPR3,RMPRL13,RMPRI13,RMPR11,RMPRERR
|
---|
24 | I '$D(IO("Q")) D
|
---|
25 | . W !,"Creating HCPCS Items in file 661.11 - 1st pass "
|
---|
26 | . Q
|
---|
27 | ;
|
---|
28 | ; Loop on HCPCS and Items as defined in the PSAS HCPCS file 661.1
|
---|
29 | S RMPRHIEN=0
|
---|
30 | HCPC S RMPRHIEN=$O(^RMPR(661.1,RMPRHIEN))
|
---|
31 | I '+RMPRHIEN G CONVX ;no more HCPCS so exit
|
---|
32 | I '$D(IO("Q")) D
|
---|
33 | . W:$X=79 ! W "."
|
---|
34 | . Q
|
---|
35 | S RMPRHREC=$G(^RMPR(661.1,RMPRHIEN,0)) ;HCPCS node
|
---|
36 | S RMPRIIEN=0
|
---|
37 | ITEM S RMPRIIEN=$O(^RMPR(661.1,RMPRHIEN,3,RMPRIIEN))
|
---|
38 | I '+RMPRIIEN G HCPC
|
---|
39 | S RMPRIREC=$G(^RMPR(661.1,RMPRHIEN,3,RMPRIIEN,0)) ;HCPCS Item node
|
---|
40 | S RMPRHCPC=$P(RMPRHREC,"^",1)
|
---|
41 | I RMPRHCPC="" G ITEM
|
---|
42 | S RMPRHIT=RMPRHCPC_"-"_RMPRIIEN
|
---|
43 | ;
|
---|
44 | ; create 661.11 rec if item in 661.3 (should be)
|
---|
45 | S RMPRGBL="^RMPR(661.3,""D"","""_RMPRHIT_""")"
|
---|
46 | LOCI S RMPRGBL=$Q(@RMPRGBL)
|
---|
47 | I $QS(RMPRGBL,1)'=661.3 G ITEM
|
---|
48 | I $QS(RMPRGBL,2)'="D" G ITEM
|
---|
49 | I $QS(RMPRGBL,3)'=RMPRHIT G ITEM
|
---|
50 | S RMPR1=$QS(RMPRGBL,4) G:RMPR1="" LOCI
|
---|
51 | S RMPR2=$QS(RMPRGBL,5) G:RMPR2="" LOCI
|
---|
52 | S RMPR3=$QS(RMPRGBL,6) G:RMPR3="" LOCI
|
---|
53 | S RMPRL13=$G(^RMPR(661.3,RMPR1,0))
|
---|
54 | S RMPRI13=$G(^RMPR(661.3,RMPR1,1,RMPR2,1,RMPR3,0))
|
---|
55 | ;
|
---|
56 | ; create 661.11 record
|
---|
57 | K RMPR11
|
---|
58 | S RMPR11("STATION")=$P(RMPRL13,"^",3) ;Station must be in DIC(4
|
---|
59 | I RMPR11("STATION")="" G LOCI
|
---|
60 | I '$D(^DIC(4,RMPR11("STATION"))) G LOCI
|
---|
61 | I $P(RMPRI13,"^",9)="V" G LOCI ;ignore non-commercial items on this pass
|
---|
62 | S RMPR11("SOURCE")="C"
|
---|
63 | S RMPR11("HCPCS")=RMPRHCPC
|
---|
64 | S RMPR11("ITEM")=RMPRIIEN
|
---|
65 | I $D(^RMPR(661.11,"ASHI",RMPR11("STATION"),RMPR11("HCPCS"),RMPR11("ITEM"))) G LOCI ;already defined
|
---|
66 | S RMPR11("UNIT")=$P(RMPRI13,"^",4)
|
---|
67 | S RMPR11("DESCRIPTION")=$P(RMPRIREC,"^",1)
|
---|
68 | S RMPR11("ITEM MASTER IEN")=""
|
---|
69 | S RMPRERR=$$CRE^RMPRPIX1(.RMPR11)
|
---|
70 | G LOCI
|
---|
71 | ;
|
---|
72 | ;exit
|
---|
73 | CONVX Q
|
---|