source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIUI.m@ 1800

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

initial load of FOIAVistA 6/30/08 version

File size: 2.8 KB
Line 
1RMPRPIUI ;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 ;
22CONV 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
30HCPC 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
37ITEM 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_""")"
46LOCI 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
73CONVX Q
Note: See TracBrowser for help on using the repository browser.