| [613] | 1 | RMPR29LA ;HIN/RVD-RMPR29 CONTINUED; 1/5/99
|
|---|
| 2 | ;;3.0;PROSTHETICS;**33**;Feb 09, 1996
|
|---|
| 3 | POST ;POST 2529-3 TO APPLIANCE/REPAIR FILE #660
|
|---|
| 4 | I '$D(RMPRDA)!('$D(^RMPR(664.1,RMPRDA,2,0))) Q
|
|---|
| 5 | S NOAC=$P(^RMPR(664.1,RMPRDA,0),U,23),NOLC=$P(^(0),U,20),RMPR("REF")=$P(^(0),U,4),RMPRG=$P(^(0),U,14)
|
|---|
| 6 | I RMPRG G GGC
|
|---|
| 7 | L +^RMPR(669.9,RMPRSITE,0):999 I $T=0 S RMPRG=DT_99 G GGC
|
|---|
| 8 | 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)
|
|---|
| 9 | GGC I 'NOAC W !!,?5,"Updating Patient's 10-2319"
|
|---|
| 10 | S RMPRDT=$P(^RMPR(664.1,RMPRDA,0),U,1),RMPRDFN=$P(^(0),U,2),SRC=$P(^(0),U,11),TO=$P(^(0),U,15) K RNEW
|
|---|
| 11 | ;S RST=$S($G(RMLOC):15,$G(RMPRGIP):12,1:11)
|
|---|
| 12 | F RA=0:0 S RA=$O(^RMPR(664.1,RMPRDA,2,RA)) Q:RA'>0 I $D(^(RA,0)) S IT=$P(^(0),U,1),QTY=$P(^(0),U,2),UN=$P(^(0),U,3),RDA=$P(^(0),U,5),TYP=$P(^(0),U,7),ELS=$P(^(0),U,8),SCAT=$P(^(0),U,9),SER=$P(^(0),U,12),HCPCS=$P($G(^(2)),U,1) D
|
|---|
| 13 | .S RMGIP=$P(^RMPR(664.1,RMPRDA,2,RA,0),U,13)
|
|---|
| 14 | .S RM3=$G(^RMPR(664.1,RMPRDA,2,RA,3))
|
|---|
| 15 | .S RMSO=$P(RM3,U,1),RMVEN=$P(RM3,U,2),RMIT=$P(RM3,U,3),RMLOC=$P(RM3,U,4)
|
|---|
| 16 | .I 'RDA S DIC="^RMPR(660,",DLAYGO=660,DIC(0)="LZ",X=RMPRDT D FILE^DICN K DLAYGO Q:+Y'>0 S RDA=+Y,RNEW=$P(Y,U,3) S $P(^RMPR(660,RDA,0),U,1)=RMPRDT,$P(^(0),U,2)=RMPRDFN,$P(^(0),U,3)=RMPRDT
|
|---|
| 17 | DR .K DR S DR="2///^S X=TYP;4.5////^S X=$G(HCPCS);5///^S X=QTY;9///^S X=SER;78///^S X=UN;8////^S X=RMPR(""STA"");11///15;62///^S X=ELS;63///^S X=SCAT;68///^S X=RMPRG;"
|
|---|
| 18 | .S DR=DR_"4.1////^S X=$P(^RMPR(661.1,HCPCS,0),U,4);13///^S X=$G(RMGIP)"
|
|---|
| 19 | .S DIE="^RMPR(660,",DA=RDA D ^DIE S RIT=$P(^RMPR(660,RDA,0),U,6) K ^RMPR(660,"AD",+RIT,RDA)
|
|---|
| 20 | .S $P(^RMPR(660,RDA,1),U,2)=$P(^RMPR(661.1,HCPCS,0),U,2)
|
|---|
| 21 | .MERGE ^RMPR(660,RDA,"DES")=^RMPR(661.1,HCPCS,2)
|
|---|
| 22 | .S $P(^RMPR(660,RDA,"DES",0),U,2)=""
|
|---|
| 23 | .S $P(^RMPR(660,RDA,0),U,14)=RMSO
|
|---|
| 24 | .S $P(^RMPR(660,RDA,0),U,9)=RMVEN
|
|---|
| 25 | .S $P(^RMPR(660,RDA,"LB"),U,12)=$E($G(^RMPR(664.1,RMPRDA,8,1,1,1,0)),1,40)
|
|---|
| 26 | .S $P(^RMPR(660,RDA,0),U,6)=IT,$P(^(0),U,27)=DUZ,$P(^RMPR(660,RDA,"LB"),U,1)=RMPR("REF"),$P(^("LB"),U,3)=SRC,$P(^("LB"),U,4)=TO,$P(^("LB"),U,14)=NOLC,$P(^RMPR(660,RDA,"AM"),U,2)=NOAC
|
|---|
| 27 | .I $D(^RMPR(664.1,RMPRDA,2,RA,1)),$O(^RMPR(664.1,RMPRDA,2,RA,1,0)) D
|
|---|
| 28 | ..K ^RMPR(660,RDA,"DES") F RW=0:0 S RW=$O(^RMPR(664.1,RMPRDA,2,RA,1,RW)) Q:RW'>0 S RN=RW S ^RMPR(660,RDA,"DES",RW,0)=^RMPR(664.1,RMPRDA,2,RA,1,RW,0)
|
|---|
| 29 | .I $D(RN) S ^RMPR(660,RDA,"DES",0)="^660.028^"_RN_U_RN_U_DT_"^^"
|
|---|
| 30 | .S DIK="^RMPR(660,",DA=RDA D:'$D(RNEW) IX^DIK D:$D(RNEW) IX1^DIK K RNEW
|
|---|
| 31 | .S $P(^RMPR(664.1,RMPRDA,2,RA,0),U,5)=RDA,$P(^RMPR(660,DA,"LB"),U,10)=RMPRDA,$P(^RMPR(664.1,RMPRDA,0),U,14)=RMPRG
|
|---|
| 32 | S DA=RMPRDA,DIK="^RMPR(664.1," D IX^DIK I $P(^RMPR(664.1,RMPRDA,0),U,15)=RMPR("STA") D:'$D(^RMPR(664.2,"B",RMPRWO)) EN4^RMPR29LU
|
|---|
| 33 | Q
|
|---|
