| 1 | RMPRN7UT ;HINES-CIOFO/HNC - DISPLAY HEADER GROUPS NPPD;2-14-01
|
|---|
| 2 | ;;3.0;PROSTHETICS;**57,84,103**;Feb 09, 1996
|
|---|
| 3 | ;
|
|---|
| 4 | ; AAC Patch 84, 2/25/04, additions, deletions and change descriptions for Groups and lines
|
|---|
| 5 | ; AAC Patch 84, 2/25/04, change description for line 6
|
|---|
| 6 | ; AAC Patch 103, 1/17/05 - NPPD CATEGORIES/LINES - NEW and REPAIR UPDATES
|
|---|
| 7 | ;
|
|---|
| 8 | DIS W !,?5,"1. 2529-3 WHEELCHAIRS AND ACCESSORIES"
|
|---|
| 9 | W !,?5,"2. 2529-3 ARTIFICIAL LEGS"
|
|---|
| 10 | W !,?5,"3. 2529-3 ARTIFICIAL ARMS AND TERMINAL DEVICES"
|
|---|
| 11 | W !,?5,"4. 2529-3 ORTHOSIS/ORTHOTICS"
|
|---|
| 12 | W !,?5,"5. 2529-3 SHOES/ORTHOTICS"
|
|---|
| 13 | W !,?5,"6. 2529-3 SENSORI-NEURO AIDS"
|
|---|
| 14 | W !,?5,"7. 2529-3 RESTORATIONS"
|
|---|
| 15 | W !,?5,"8. 2529-3 OXYGEN AND RESPIRATORY"
|
|---|
| 16 | W !,?5,"9. 2529-3 MEDICAL EQUIPMENT"
|
|---|
| 17 | W !,?5,"10. 2529-3 ALL OTHER SUPPLIES AND EQUIPMENT"
|
|---|
| 18 | W !,?5,"11. 2529-3 HOME DIALYSIS PROGRAM"
|
|---|
| 19 | W !,?5,"12. 2529-3 ADAPTIVE EQUIPMENT"
|
|---|
| 20 | W !,?5,"13. 2529-3 HISA"
|
|---|
| 21 | W !,?5,"14. 2529-3 SURGICAL IMPLANTS"
|
|---|
| 22 | W !,?5,"15. 2529-3 MISC"
|
|---|
| 23 | W !,?5,"16. 2529-3 REPAIR"
|
|---|
| 24 | ASK ;
|
|---|
| 25 | K DIR,DTOUT,DIRUT
|
|---|
| 26 | S RMPRCDE=""
|
|---|
| 27 | S DIR(0)="N^1:16:0"
|
|---|
| 28 | S DIR("A")="Select 2529-3 NPPD Group "
|
|---|
| 29 | D ^DIR
|
|---|
| 30 | G:$D(DIRUT)!($D(DTOUT)) EXIT
|
|---|
| 31 | S BR=0,BRC=0 K BRA W @IOF
|
|---|
| 32 | I Y=1 S SELY=10
|
|---|
| 33 | I Y=2 S SELY=20
|
|---|
| 34 | I Y=3 S SELY=30
|
|---|
| 35 | I Y=4 S SELY=40
|
|---|
| 36 | I Y=5 S SELY=50
|
|---|
| 37 | I Y=6 S SELY=60
|
|---|
| 38 | I Y=7 S SELY=70
|
|---|
| 39 | I Y=8 S SELY=80
|
|---|
| 40 | I Y=9 S SELY=90
|
|---|
| 41 | I Y=10 S SELY=91
|
|---|
| 42 | I Y=11 S SELY=92
|
|---|
| 43 | I Y=12 S SELY=93
|
|---|
| 44 | I Y=13 S SELY=94
|
|---|
| 45 | I Y=14 S SELY=96
|
|---|
| 46 | I Y=15 S SELY=99
|
|---|
| 47 | I Y=16 S SELY=100
|
|---|
| 48 | F S BR=$O(^TMP($J,"RMPRCODE",BR)) Q:BR="" D
|
|---|
| 49 | .I $E(BR,1,2)=SELY S BRC=BRC+1 W !?5,BRC_".",?10,BR,?18,^(BR) S BRA(BRC,BR)=""
|
|---|
| 50 | .Q
|
|---|
| 51 | I SELY=100 D
|
|---|
| 52 | . D RSEL
|
|---|
| 53 | . Q
|
|---|
| 54 | E D
|
|---|
| 55 | . D NSEL
|
|---|
| 56 | . Q
|
|---|
| 57 | G:$D(DIRUT)!($D(DTOUT)) EXIT
|
|---|
| 58 | Q
|
|---|
| 59 | RSEL ;repair selection
|
|---|
| 60 | N CNT,Y,OFFS,TXT,I
|
|---|
| 61 | S CNT=$P(^TMP($J,"RMPRCODE"),U,2) ; num of NPPD repair lines
|
|---|
| 62 | S OFFS=CNT-(CNT\2)-1
|
|---|
| 63 | F I=0:1:OFFS D
|
|---|
| 64 | . S TXT=$P($T(REP+I^RMPRN72),";;",2)
|
|---|
| 65 | . W !,$J(I+1,2)_".",?5,$P(TXT,";",1),?14,$P(TXT,";",2)
|
|---|
| 66 | . S TXT=$P($T(REP+I+OFFS+1^RMPRN72),";;",2)
|
|---|
| 67 | . Q:$E(TXT)'="R"
|
|---|
| 68 | . W ?35,$J(I+2+OFFS,2)_".",?40,$P(TXT,";",1),?51,$P(TXT,";",2)
|
|---|
| 69 | . Q
|
|---|
| 70 | F I=OFFS:1:17 W !
|
|---|
| 71 | S DIR(0)="N^1:"_CNT_":0"
|
|---|
| 72 | S DIR("A")="Select 2529-3 NPPD Line "
|
|---|
| 73 | D ^DIR
|
|---|
| 74 | Q:$D(DIRUT)!($D(DTOUT))
|
|---|
| 75 | S TXT=$P($T(REP+Y-1^RMPRN72),";;",2)
|
|---|
| 76 | S RMPRCDE=$P(TXT,";",1)
|
|---|
| 77 | Q
|
|---|
| 78 | NSEL ;new select
|
|---|
| 79 | I BR'="" W "QUIT" Q
|
|---|
| 80 | W !
|
|---|
| 81 | S DIR(0)="N^1:"_BRC_":0"
|
|---|
| 82 | S DIR("A")="Select 2529-3 NPPD Line "
|
|---|
| 83 | D ^DIR
|
|---|
| 84 | Q:$D(DIRUT)!($D(DTOUT))
|
|---|
| 85 | S RMPRCDE=$O(BRA(Y,RMPRCDE))
|
|---|
| 86 | Q
|
|---|
| 87 | EXIT ;exit on ^ or timeout
|
|---|
| 88 | K ^TMP($J)
|
|---|
| 89 | Q
|
|---|
| 90 | ;END
|
|---|
