[613] | 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
|
---|