source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRN7UT.m

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.4 KB
Line 
1RMPRN7UT ;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 ;
8DIS 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"
24ASK ;
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
59RSEL ;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
78NSEL ;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
87EXIT ;exit on ^ or timeout
88 K ^TMP($J)
89 Q
90 ;END
Note: See TracBrowser for help on using the repository browser.