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