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