| [613] | 1 | RMPRKIL ;JLT/PHX-REMOVE PROSTHETICS LOAN PROGRAM ;08/12/1994
|
|---|
| 2 | ;;3.0;PROSTHETICS;;Feb 09, 1996
|
|---|
| 3 | F RMPRL=0:0 S RMPRL=$O(^RMPR(660.1,RMPRL)) Q:RMPRL'>0 I $D(^RMPR(660.1,RMPRL,0)),$P(^(0),U,9)=1 S DIK="^RMPR(660.1,",DA=RMPRL D ^DIK
|
|---|
| 4 | K ^RMPR(660.1,"AF"),^RMPR(660.1,"AG"),DA,DIK
|
|---|
| 5 | F DA=.05,6,7,8,9,12,19,21,22 S DA(1)="660.1",DIK="^DD(660.1," D ^DIK
|
|---|
| 6 | S DIU=660.18,DIU(0)="S" D EN^DIU2
|
|---|
| 7 | K DA,DIK S DIK="^RMPR(660.2," D IXALL^DIK
|
|---|
| 8 | S DIU="^RMPR(660.2,",DIU(0)="D" D EN^DIU2 K DIU
|
|---|
| 9 | OPT F OPT="RMPR LOAN DEL","RMPR LOAN CREATE","RMPR LOAN RET","RMPR LOAN DISP","RMPR LOAN FOLLOW-UP","RMPR LOAN PRINT ALL","RMPR LOAN EDIT","RMPR LOAN STAT","RMPR LOAN MENU" D
|
|---|
| 10 | .F REN=0:0 S REN=$O(^DIC(19,"B",OPT,REN)) Q:REN'>0 S DA=REN,DIK="^DIC(19," D ^DIK K DA,DIK
|
|---|
| 11 | EXIT D KILL^XUSCLEAN Q
|
|---|
