| [613] | 1 | RMPRUTL4 ;HINES CIOFO/HNC - FIX RECORDS IN FILE 660 WITH NO AMIS GROUPER ;3/25/04 12:47
|
|---|
| 2 | ;;3.0;PROSTHETICS;**34,35,87,90**;Feb 09, 1996
|
|---|
| 3 | ;post init
|
|---|
| 4 | I '$D(DUZ) W !,"DUZ NOT DEFINED!" Q
|
|---|
| 5 | D DIV4^RMPRSIT,HOME^%ZIS G:$D(X) END
|
|---|
| 6 | S RMPRA=0
|
|---|
| 7 | F S RMPRA=$O(^RMPR(660,RMPRA)) Q:RMPRA'>0 D
|
|---|
| 8 | .Q:$G(^RMPR(660,RMPRA,"AMS"))'=""
|
|---|
| 9 | .Q:$G(^RMPR(660,RMPRA,0))=""
|
|---|
| 10 | .Q:$P(^RMPR(660,RMPRA,0),U,15)["*"
|
|---|
| 11 | .Q:$P(^RMPR(660,RMPRA,0),U,10)'=RMPR("STA")
|
|---|
| 12 | .W "."
|
|---|
| 13 | .L +^RMPR(669.9,RMPRSITE,0):9999 I $T=0 S RMPRG=DT_98
|
|---|
| 14 | .I '$G(RMPRG) S RMPRG=$P(^RMPR(669.9,RMPRSITE,0),U,7),RMPRG=RMPRG-1,$P(^RMPR(669.9,RMPRSITE,0),U,7)=RMPRG L -^RMPR(669.9,RMPRSITE,0)
|
|---|
| 15 | .W RMPRG
|
|---|
| 16 | .S $P(^RMPR(660,RMPRA,"AMS"),U,1)=RMPRG
|
|---|
| 17 | .K RMPRG
|
|---|
| 18 | W !,"ALL DONE"
|
|---|
| 19 | K RMPRA,RMPR,RMPRSITE Q
|
|---|
| 20 | CHG ;change nppd line ; HCPCS
|
|---|
| 21 | S $P(^RMPR(661.1,2757,0),U,6)="R90 A"
|
|---|
| 22 | S $P(^RMPR(661.1,2757,0),U,7)=""
|
|---|
| 23 | Q
|
|---|
| 24 | SERIAL ;enter product info for recall
|
|---|
| 25 | D GETS^DIQ(660,DA,".02;4;4.5;7;11;23;24;27;89","E","RMPRX")
|
|---|
| 26 | Q
|
|---|
| 27 | END ;END
|
|---|
