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