source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRN6PR.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 5.5 KB
Line 
1RMPRN6PR ;HINES/HNC -PRINT REPAIR WORKSHEETS ;2/14/98
2 ;;3.0;PROSTHETICS;**31,32,39,48,51,84,103**;Feb 09, 1996
3 ;
4 ; AAC Patch 84, 02-25-04, additions, deletions and change descriptions for Groups and lines
5 ; AAC - Patch 84 change description for R60, 2/25/04
6 ; AAC - Patch 103 NPPD CATEGORIES/LINES - NEW and REPAIR
7 ;
8 K ^TMP($J,"RS")
9 S STN=1
10 F S STN=$O(^TMP($J,"R",STN)) Q:STN="" D HDR,CDATA,SUM
11 Q
12HDR ;leave this form feed alone
13 W @IOF
14 W !,"REPORT OF REPAIR PROSTHETICS ACTIVITIES"
15 ;header depending on sort selected
16 W !,$$HDR^RMPRN6S(RMPRDET)
17 S Y=DATE(1) D DD^%DT W !,Y," - " S Y=DATE(2) D DD^%DT W Y
18 W !,?10,"STATION: ",STN
19 ;RMPRSUM if summary header
20 Q:$G(RMPRSUM)
21 W !!
22 W !,"Line",?6,"Item",?21,"VA",?26,"Com",?31,"Total",?37,"Cost",?46
23 W "Ave Com",?54
24 W "SC/OP",?61,"NSC/OP",?68,"SC/IP",?74,"NSC/IP"
25 I IOM>120 D
26 .W ?83,"SP LEG"
27 .W ?90,"A&A",?97,"PHC",?104,"ELG REF",?112,"NEW",?120,"$ELG REF"
28 Q
29CDATA ;
30 Q:FL=1
31 S LINE="",LINEP=""
32 S (CA,CB,CC,CD,CE,CF,CG,CH,CI,CJ,CK,CL,CM)=0
33 F S LINE=$O(^TMP($J,"R",STN,LINE)) Q:LINE="" Q:FL=1 D
34 .I $E(LINE,0,3)'=$E(LINEP,0,3) D SUM Q:FL=1 D LBLR
35 .W !,LINE,?6,$E($P(^TMP($J,"R",STN,LINE),U,15),1,15)
36 .W ?21,$P(^TMP($J,"R",STN,LINE),U,1) S CA=CA+$P(^(LINE),U,1)
37 .W ?26,$P(^TMP($J,"R",STN,LINE),U,2) S CB=CB+$P(^(LINE),U,2)
38 .W ?31,$P(^TMP($J,"R",STN,LINE),U,1)+($P(^TMP($J,"R",STN,LINE),U,2))
39 .W ?37,$FN($J($P(^TMP($J,"R",STN,LINE),U,3),0,0),",") S CC=CC+$P(^(LINE),U,3)
40 .W:$P(^TMP($J,"R",STN,LINE),U,2)>0 ?46,$FN($J(($P(^(LINE),U,3))/($P(^(LINE),U,2)),0,0),",")
41 .W ?55,$P(^TMP($J,"R",STN,LINE),U,4) S CD=CD+$P(^(LINE),U,4)
42 .W ?62,$P(^TMP($J,"R",STN,LINE),U,5) S CE=CE+$P(^(LINE),U,5)
43 .W ?69,$P(^TMP($J,"R",STN,LINE),U,6) S CF=CF+$P(^(LINE),U,6)
44 .W ?76,$P(^TMP($J,"R",STN,LINE),U,7) S CG=CG+$P(^(LINE),U,7)
45 .S CH=CH+$P(^TMP($J,"R",STN,LINE),U,8)
46 .S CI=CI+$P(^TMP($J,"R",STN,LINE),U,9)
47 .S CJ=CJ+$P(^TMP($J,"R",STN,LINE),U,10)
48 .S CK=CK+$P(^TMP($J,"R",STN,LINE),U,11)
49 .S CL=CL+$P(^TMP($J,"R",STN,LINE),U,12)
50 .S CM=CM+$P(^TMP($J,"R",STN,LINE),U,16)
51 .I IOM>120 D
52 ..W ?83,$P(^TMP($J,"R",STN,LINE),U,8)
53 ..W ?90,$P(^TMP($J,"R",STN,LINE),U,9)
54 ..W ?97,$P(^TMP($J,"R",STN,LINE),U,10)
55 ..W ?104,$P(^TMP($J,"R",STN,LINE),U,11)
56 ..W ?112,$P(^TMP($J,"R",STN,LINE),U,12)
57 ..W ?120,$P(^TMP($J,"R",STN,LINE),U,16)
58 .S LINEP=LINE
59 Q
60SUM ;Print summary for group
61 Q:FL=1
62 I LINEP'="" D Q:FL=1
63 .I $Y+13>IOSL,IOST["C-" D CHK Q:FL=1
64 .S GROUPT=CA_U_CB_U_(CA+CB)_U_$J(CC,0,0)_U_CD_U_CE_U_CF_U_CG_U_CH_U_CI_U_CJ_U_CK_U_CL_U_CM
65 .W !,LN,!
66 .W ?21,CA,?26,CB,?31,(CA+CB),?37,$FN($J(CC,0,0),","),?55,CD,?62,CE,?69,CF,?76,CG
67 .I IOM>120 W ?83,CH,?90,CI,?97,CJ,?104,CK,?112,CL,?120,CM
68 .W !
69 .D LBLG
70 .S ^TMP($J,"RS",STN,GROUP,STN)=GROUPT
71 .S (CA,CB,CC,CD,CE,CF,CG,CH,CI,CJ,CK,CL,CM)=0
72 Q:$G(LINEP)'="R99 Z"
73 D FSUM S RMPRSUM=1 D HDR K RMPRSUM
74 W !!,"STATION SUMMARY (REPAIR ACTIVITIES)"
75 ;W !,$$HDR^RMPRN6S(RMPRDET)
76 W !,?21,"VA",?31,"Com",?41,"Total",?51,"Cost",?61
77 W "Ave Com",?71,"Elg Ref $"
78 W !,LN
79 W !,?21,CA,?31,CB,?41,(CA+CB),?51,"$"_$FN($J(CC,0,0),",")
80 W ?61
81 I CB>0 W "$"_$FN($J((CC/CB),0,0),",")
82 W ?71
83 I CM>0 W "$"_$FN($J((CM),0,0),",")
84 W !,LN,!
85 W !,?21,"SC/OP",?31,"NSC/OP",?41,"SC/IP",?51,"NSC/IP"
86 W !,LN,!
87 W ?21,CD,?31,CE,?41,CF,?51,CG
88 W !,LN
89 W !,?21,"SPEC LEG",?31,"A&A",?41,"PHC",?51,"ELG REF",?61,"NEW"
90 W !,LN,!,?21,CH,?31,CI,?41,CJ,?51,CK,?61,CL,!,LN
91 W !,?21,"Total Disability: ",(CD+CE+CF+CG),!,LN,!
92 S (CA,CB,CC,CD,CE,CF,CG,CH,CI,CJ,CK,CL)=0
93 I IOST["C-" D CHK
94 Q
95LBLG ;group description fo final repair summary
96 I $E(LINEP,0,3)="R07" S GROUP=$E(LINEP,0,3)_" HEARING AID, LOCAL REPAIRS"
97 I $E(LINEP,0,3)="R10" S GROUP=$E(LINEP,0,3)_" WHEELCHAIRS AND ACCESSORIES"
98 I $E(LINEP,0,3)="R20" S GROUP=$E(LINEP,0,3)_" ARTIFICIAL LEGS"
99 I $E(LINEP,0,3)="R30" S GROUP=$E(LINEP,0,3)_" ARTIFICIAL ARMS AND TERMINAL DEVICES"
100 I $E(LINEP,0,3)="R40" S GROUP=$E(LINEP,0,3)_" ORTHOSIS"
101 I $E(LINEP,0,3)="R50" S GROUP=$E(LINEP,0,3)_" SHOES/ORTHOTICS"
102 I $E(LINEP,0,3)="R60" S GROUP=$E(LINEP,0,3)_" SENSORI-NEURO AIDS"
103 I $E(LINEP,0,3)="R70" S GROUP=$E(LINEP,0,3)_" HOME DIALYSIS EQUIPMENT"
104 I $E(LINEP,0,3)="R80" S GROUP=$E(LINEP,0,3)_" MEDICAL EQUIPMENT"
105 I $E(LINEP,0,3)="R90" S GROUP=$E(LINEP,0,3)_" ALL OTHER"
106 I $E(LINEP,0,3)="R91" S GROUP=$E(LINEP,0,3)_" OXYGEN & RESPIRATORY"
107 I $E(LINEP,0,3)="R92" S GROUP=$E(LINEP,0,3)_" AUTO & VAN EQUIP"
108 I $E(LINEP,0,3)="R99" S GROUP=$E(LINEP,0,3)_" MISC"
109 Q
110LBLR ;label for repair group
111 I $E(LINE,0,3)="R10" W !,"WHEELCHAIRS AND ACCESSORIES"
112 I $E(LINE,0,3)="R20" W !,"ARTIFICIAL LEGS"
113 I $E(LINE,0,3)="R30" W !,"ARTIFICIAL ARMS AND TERMINAL DEVICES"
114 I $E(LINE,0,3)="R40" W !,"ORTHOSIS"
115 I $E(LINE,0,3)="R50" W !,"SHOES/ORTHOTICS"
116 I $E(LINE,0,3)="R60" W !,"SENSORI-NEURO AIDS"
117 I $E(LINE,0,3)="R70" W !,"HOME DIALYSIS EQUIPMENT"
118 I $E(LINE,0,3)="R80",IOST'["C-" D HDR W !,"MEDICAL EQUIPMENT"
119 I $E(LINE,0,3)="R80",IOST["C-" W !,"MEDICAL EQUIPMENT"
120 I $E(LINE,0,3)="R90" W !,"ALL OTHER"
121 I $E(LINE,0,3)="R91" W !,"OXYGEN & RESPIRATORY"
122 I $E(LINE,0,3)="R92" W !,"AUTO & VAN EQUIP"
123 I $E(LINE,0,3)="R99" W !,"MISC"
124 Q
125FSUM ;final summay on Repair Worksheets STATION
126 S H=0
127 F S H=$O(^TMP($J,"RS",STN,H)) Q:H="" D
128 .S H1=0,H2=0
129 .F S H1=$O(^TMP($J,"RS",STN,H,H1)) Q:H1="" D
130 ..Q:H1'=STN
131 ..S H2=^TMP($J,"RS",STN,H,H1)
132 ..S CA=CA+$P(H2,U,1)
133 ..S CB=CB+$P(H2,U,2)
134 ..S CC=CC+$P(H2,U,4)
135 ..S CD=CD+$P(H2,U,5)
136 ..S CE=CE+$P(H2,U,6)
137 ..S CF=CF+$P(H2,U,7)
138 ..S CG=CG+$P(H2,U,8)
139 ..S CH=CH+$P(H2,U,9)
140 ..S CI=CI+$P(H2,U,10)
141 ..S CJ=CJ+$P(H2,U,11)
142 ..S CK=CK+$P(H2,U,12)
143 ..S CL=CL+$P(H2,U,13)
144 ..S CM=CM+$P(H2,U,14)
145 Q
146CHK ;
147 K DIR W !! S DIR(0)="E" D ^DIR S:+Y'>0 FL=1
148 W @IOF
149 Q
150 ;END
Note: See TracBrowser for help on using the repository browser.