| 1 | ACKQDWLR ;HCIOFO/BH-Print A&SP Capitation Report ; [ 06/06/99 10:45 AM ]
|
---|
| 2 | ;;3.0;QUASAR;**1**;Feb 11, 2000
|
---|
| 3 | ;
|
---|
| 4 | ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
|
---|
| 5 | ;
|
---|
| 6 | ;
|
---|
| 7 | SUMZIP ; Display summary of ZIP data
|
---|
| 8 | Q:'$D(^TMP("ACKQDWLP",$J,"S",3))
|
---|
| 9 | ;
|
---|
| 10 | N ACKF,ACKZSCTA,ACKZSTTA,ACKZSUTA,ACKZSPTA,ACKDD,ACKZC
|
---|
| 11 | N ACKSTR,ACKZSCTS,ACKZSTTS,ACKZSUTS,ACKZSPTS,ACKTYPE
|
---|
| 12 | S (ACKZSCTA,ACKZSTTA,ACKZSUTA,ACKZSPTA,ACKZSCTS,ACKZSTTS,ACKZSUTS,ACKZSPTS)=0
|
---|
| 13 | S AS="",ACKTYPE="ZIP"
|
---|
| 14 | ; Display Heading and sub heading
|
---|
| 15 | D HEADER,ZIPHD
|
---|
| 16 | ;
|
---|
| 17 | F S AS=$O(^TMP("ACKQDWLP",$J,"S",3,AS)) Q:AS=""!($D(DIRUT)) D
|
---|
| 18 | .I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HEADER,ZIPHD
|
---|
| 19 | .S XAS=$S(AS="A":"Audiology",1:"Speech Pathology")
|
---|
| 20 | .W !," "_XAS,":"
|
---|
| 21 | .S (ACKZC,ACKSTR)=""
|
---|
| 22 | .F S ACKZC=$O(^TMP("ACKQDWLP",$J,"S",3,AS,ACKZC)) Q:ACKZC=""!($D(DIRUT)) D
|
---|
| 23 | ..I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HEADER,ZIPHD W !," "_XAS,":"
|
---|
| 24 | ..S ACKF=1,ACKDD=""
|
---|
| 25 | ..F S ACKDD=$O(^TMP("ACKQDWLP",$J,"S",3,AS,ACKZC,ACKDD)) Q:ACKDD=""!($D(DIRUT)) D
|
---|
| 26 | ...S ACKSTR=^TMP("ACKQDWLP",$J,"S",3,AS,ACKZC,ACKDD)
|
---|
| 27 | ...; Print Zip data
|
---|
| 28 | ...W !
|
---|
| 29 | ...I ACKF W " "_ACKZC S ACKF=0
|
---|
| 30 | ...W ?9,$P(ACKDIV(ACKDD),U,3)
|
---|
| 31 | ...W ?32,$S($P(ACKSTR,U,1):$P(ACKSTR,U,1),1:"0")
|
---|
| 32 | ...W ?45,$S($P(ACKSTR,U,2):$P(ACKSTR,U,2),1:"0")
|
---|
| 33 | ...W ?59,$S($P(ACKSTR,U,3):$P(ACKSTR,U,3),1:"0")
|
---|
| 34 | ...W ?72,$S($P(ACKSTR,U,4):$P(ACKSTR,U,4),1:"0")
|
---|
| 35 | ...;
|
---|
| 36 | ...; Calculate Totals
|
---|
| 37 | ...S @("ACKZSCT"_AS)=@("ACKZSCT"_AS)+$P(ACKSTR,U,1)
|
---|
| 38 | ...S @("ACKZSTT"_AS)=@("ACKZSTT"_AS)+$P(ACKSTR,U,2)
|
---|
| 39 | ...S @("ACKZSUT"_AS)=@("ACKZSUT"_AS)+$P(ACKSTR,U,3)
|
---|
| 40 | ...S @("ACKZSPT"_AS)=@("ACKZSPT"_AS)+$P(ACKSTR,U,4)
|
---|
| 41 | ..;
|
---|
| 42 | ..Q:$D(DIRUT)
|
---|
| 43 | .Q:$D(DIRUT)
|
---|
| 44 | .S $P(LN,"-",80)="" W !,LN
|
---|
| 45 | .W !," "_XAS," Total: ",?32,@("ACKZSCT"_AS),?45,@("ACKZSTT"_AS)
|
---|
| 46 | .W ?59,@("ACKZSUT"_AS),?72,@("ACKZSPT"_AS),!
|
---|
| 47 | ;
|
---|
| 48 | Q:$D(DIRUT)
|
---|
| 49 | ; Calculate and Display Grand Total for ZIP
|
---|
| 50 | N ACKGT1,ACKGT2,ACKGT3,ACKGT4
|
---|
| 51 | S ACKGT1=$G(ACKZSCTS)+$G(ACKZSCTA)
|
---|
| 52 | S ACKGT2=$G(ACKZSTTS)+$G(ACKZSTTA)
|
---|
| 53 | S ACKGT3=$G(ACKZSUTS)+$G(ACKZSUTA)
|
---|
| 54 | S ACKGT4=$G(ACKZSPTS)+$G(ACKZSPTA)
|
---|
| 55 | I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HEADER,ZIPHD W !," "_XAS,":"
|
---|
| 56 | W !," Grand Total",?32,ACKGT1,?45,ACKGT2,?59,ACKGT3,?72,ACKGT4,!
|
---|
| 57 | D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT)
|
---|
| 58 | ;
|
---|
| 59 | Q
|
---|
| 60 | ;
|
---|
| 61 | SUMICD ; Display summary of ICD data
|
---|
| 62 | Q:'$D(^TMP("ACKQDWLP",$J,"S",1))
|
---|
| 63 | ;
|
---|
| 64 | N ACKF,ACKISCTA,ACKISTTA,ACKISUTA,ACKDD,ACKIC
|
---|
| 65 | N ACKSTR,ACKISCTS,ACKISTTS,ACKISUTS,ACKTYPE
|
---|
| 66 | S (ACKISCTA,ACKISTTA,ACKISUTA,ACKISCTS,ACKISTTS,ACKISUTS)=0
|
---|
| 67 | S ACKTYPE="ICD"
|
---|
| 68 | ; Display main heading and sub heading
|
---|
| 69 | D HEADER,ICDCPTHD
|
---|
| 70 | ;
|
---|
| 71 | S AS=""
|
---|
| 72 | F S AS=$O(^TMP("ACKQDWLP",$J,"S",1,AS)) Q:AS=""!($D(DIRUT)) D
|
---|
| 73 | . I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HEADER,ICDCPTHD
|
---|
| 74 | . S XAS=$S(AS="A":"Audiology",1:"Speech Pathology")
|
---|
| 75 | . W !," "_XAS,":"
|
---|
| 76 | . S (ACKIC,ACKSTR)=""
|
---|
| 77 | . F S ACKIC=$O(^TMP("ACKQDWLP",$J,"S",1,AS,ACKIC)) Q:ACKIC=""!($D(DIRUT)) D
|
---|
| 78 | .. I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HEADER,ICDCPTHD W !," "_XAS,":"
|
---|
| 79 | .. S ACKF=1,ACKDD=""
|
---|
| 80 | .. F S ACKDD=$O(^TMP("ACKQDWLP",$J,"S",1,AS,ACKIC,ACKDD)) Q:ACKDD=""!($D(DIRUT)) D
|
---|
| 81 | ... S ACKSTR=^TMP("ACKQDWLP",$J,"S",1,AS,ACKIC,ACKDD)
|
---|
| 82 | ...; Print ICD data
|
---|
| 83 | ... W !
|
---|
| 84 | ... I ACKF W " "_ACKIC S ACKF=0
|
---|
| 85 | ... W ?9,$P(ACKDIV(ACKDD),U,3)
|
---|
| 86 | ... W ?32,$S($P(ACKSTR,U,1):$P(ACKSTR,U,1),1:"0")
|
---|
| 87 | ... W ?45,$S($P(ACKSTR,U,2):$P(ACKSTR,U,2),1:"0")
|
---|
| 88 | ... W ?59,$S($P(ACKSTR,U,3):$P(ACKSTR,U,3),1:"0")
|
---|
| 89 | ...;
|
---|
| 90 | ...; Calculate Totals
|
---|
| 91 | ... S @("ACKISCT"_AS)=@("ACKISCT"_AS)+$P(ACKSTR,U,1)
|
---|
| 92 | ... S @("ACKISTT"_AS)=@("ACKISTT"_AS)+$P(ACKSTR,U,2)
|
---|
| 93 | ... S @("ACKISUT"_AS)=@("ACKISUT"_AS)+$P(ACKSTR,U,3)
|
---|
| 94 | ..;
|
---|
| 95 | .. Q:$D(DIRUT)
|
---|
| 96 | . Q:$D(DIRUT)
|
---|
| 97 | . S $P(LN,"-",80)="" W !,LN
|
---|
| 98 | . W !," "_XAS," Total: ",?32,@("ACKISCT"_AS),?45,@("ACKISTT"_AS)
|
---|
| 99 | . W ?59,@("ACKISUT"_AS),!
|
---|
| 100 | ;
|
---|
| 101 | Q:$D(DIRUT)
|
---|
| 102 | ; Calculate and Display Grand Total for ZIP
|
---|
| 103 | N ACKGT1,ACKGT2,ACKGT3
|
---|
| 104 | S ACKGT1=$G(ACKISCTS)+$G(ACKISCTA)
|
---|
| 105 | S ACKGT2=$G(ACKISTTS)+$G(ACKISTTA)
|
---|
| 106 | S ACKGT3=$G(ACKISUTS)+$G(ACKISUTA)
|
---|
| 107 | ;
|
---|
| 108 | I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HEADER,ICDCPTHD W !," "_XAS,":"
|
---|
| 109 | W !," Grand Total",?32,ACKGT1,?45,ACKGT2,?59,ACKGT3,!
|
---|
| 110 | D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT)
|
---|
| 111 | ;
|
---|
| 112 | Q
|
---|
| 113 | ;
|
---|
| 114 | SUMCPT ; Display summary of CPT data
|
---|
| 115 | Q:'$D(^TMP("ACKQDWLP",$J,"S",2))
|
---|
| 116 | ;
|
---|
| 117 | N ACKF,ACKCSCTA,ACKCSTTA,ACKCSUTA,ACKDD,ACKCC
|
---|
| 118 | N ACKSTR,ACKCSCTS,ACKCSTTS,ACKCSUTS,ACKTYPE
|
---|
| 119 | S (ACKCSCTA,ACKCSTTA,ACKCSUTA,ACKCSCTS,ACKCSTTS,ACKCSUTS)=0
|
---|
| 120 | S ACKTYPE="CPT"
|
---|
| 121 | ; Display main heading and sub heading
|
---|
| 122 | D HEADER,ICDCPTHD
|
---|
| 123 | ;
|
---|
| 124 | S AS=""
|
---|
| 125 | F S AS=$O(^TMP("ACKQDWLP",$J,"S",2,AS)) Q:AS=""!($D(DIRUT)) D
|
---|
| 126 | . I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HEADER,ICDCPTHD
|
---|
| 127 | . S XAS=$S(AS="A":"Audiology",1:"Speech Pathology")
|
---|
| 128 | . W !," "_XAS,":"
|
---|
| 129 | . S (ACKCC,ACKSTR)=""
|
---|
| 130 | .;
|
---|
| 131 | . F S ACKCC=$O(^TMP("ACKQDWLP",$J,"S",2,AS,ACKCC)) Q:ACKCC=""!($D(DIRUT)) D
|
---|
| 132 | .. I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HEADER,ICDCPTHD W " "_XAS,":"
|
---|
| 133 | .. S ACKF=1,ACKDD=""
|
---|
| 134 | .. F S ACKDD=$O(^TMP("ACKQDWLP",$J,"S",2,AS,ACKCC,ACKDD)) Q:ACKDD=""!($D(DIRUT)) D
|
---|
| 135 | ... S ACKSTR=^TMP("ACKQDWLP",$J,"S",2,AS,ACKCC,ACKDD)
|
---|
| 136 | ...; Print Zip data
|
---|
| 137 | ... W !
|
---|
| 138 | ... I ACKF W " "_$$GET1^DIQ(509850.4,ACKCC_",",.01) S ACKF=0
|
---|
| 139 | ... W ?9,$P(ACKDIV(ACKDD),U,3)
|
---|
| 140 | ... W ?32,$S($P(ACKSTR,U,1):$P(ACKSTR,U,1),1:"0")
|
---|
| 141 | ... W ?45,$S($P(ACKSTR,U,2):$P(ACKSTR,U,2),1:"0")
|
---|
| 142 | ... W ?59,$S($P(ACKSTR,U,3):$P(ACKSTR,U,3),1:"0")
|
---|
| 143 | ...;
|
---|
| 144 | ...; Calculate Totals
|
---|
| 145 | ... S @("ACKCSCT"_AS)=@("ACKCSCT"_AS)+$P(ACKSTR,U,1)
|
---|
| 146 | ... S @("ACKCSTT"_AS)=@("ACKCSTT"_AS)+$P(ACKSTR,U,2)
|
---|
| 147 | ... S @("ACKCSUT"_AS)=@("ACKCSUT"_AS)+$P(ACKSTR,U,3)
|
---|
| 148 | ..;
|
---|
| 149 | .. Q:$D(DIRUT)
|
---|
| 150 | . Q:$D(DIRUT)
|
---|
| 151 | . S $P(LN,"-",80)="" W !,LN
|
---|
| 152 | . W !," "_XAS," Total: ",?32,@("ACKCSCT"_AS),?45,@("ACKCSTT"_AS)
|
---|
| 153 | . W ?59,@("ACKCSUT"_AS),!
|
---|
| 154 | ;
|
---|
| 155 | Q:$D(DIRUT)
|
---|
| 156 | ; Calculate and Display Grand Total for CPT
|
---|
| 157 | N ACKGT1,ACKGT2,ACKGT3
|
---|
| 158 | S ACKGT1=$G(ACKCSCTS)+$G(ACKCSCTA)
|
---|
| 159 | S ACKGT2=$G(ACKCSTTS)+$G(ACKCSTTA)
|
---|
| 160 | S ACKGT3=$G(ACKCSUTS)+$G(ACKCSUTA)
|
---|
| 161 | ;
|
---|
| 162 | I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HEADER,ICDCPTHD W !," "_XAS,":"
|
---|
| 163 | W !," Grand Total",?32,ACKGT1,?45,ACKGT2,?59,ACKGT3,!
|
---|
| 164 | D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT)
|
---|
| 165 | ;
|
---|
| 166 | Q
|
---|
| 167 | ;
|
---|
| 168 | SUMEC ; Display summary of EC data
|
---|
| 169 | Q:'$D(^TMP("ACKQDWLP",$J,"S",5))
|
---|
| 170 | ;
|
---|
| 171 | N ACKF,ACKCSCTA,ACKCSTTA,ACKCSUTA,ACKDD,ACKCC
|
---|
| 172 | N ACKSTR,ACKCSCTS,ACKCSTTS,ACKCSUTS,ACKTYPE
|
---|
| 173 | S (ACKCSCTA,ACKCSTTA,ACKCSUTA,ACKCSCTS,ACKCSTTS,ACKCSUTS)=0
|
---|
| 174 | S ACKTYPE="EC"
|
---|
| 175 | ; Display main heading and sub heading
|
---|
| 176 | D HEADER,ICDCPTHD
|
---|
| 177 | S AS=""
|
---|
| 178 | F S AS=$O(^TMP("ACKQDWLP",$J,"S",5,AS)) Q:AS=""!($D(DIRUT)) D
|
---|
| 179 | . I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HEADER,ICDCPTHD
|
---|
| 180 | . S XAS=$S(AS="A":"Audiology",1:"Speech Pathology")
|
---|
| 181 | . W !," "_XAS,":"
|
---|
| 182 | . S (ACKCC,ACKSTR)=""
|
---|
| 183 | .;
|
---|
| 184 | . F S ACKCC=$O(^TMP("ACKQDWLP",$J,"S",5,AS,ACKCC)) Q:ACKCC=""!($D(DIRUT)) D
|
---|
| 185 | .. I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HEADER,ICDCPTHD W " "_XAS,":"
|
---|
| 186 | .. S ACKF=1,ACKDD=""
|
---|
| 187 | .. F S ACKDD=$O(^TMP("ACKQDWLP",$J,"S",5,AS,ACKCC,ACKDD)) Q:ACKDD=""!($D(DIRUT)) D
|
---|
| 188 | ... S ACKSTR=^TMP("ACKQDWLP",$J,"S",5,AS,ACKCC,ACKDD)
|
---|
| 189 | ...; Print EC data
|
---|
| 190 | ... W !
|
---|
| 191 | ... I ACKF W " "_$$GET1^DIQ(725,ACKCC_",",1,"I") S ACKF=0
|
---|
| 192 | ... W ?9,$P(ACKDIV(ACKDD),U,3)
|
---|
| 193 | ... W ?32,$S($P(ACKSTR,U,1):$P(ACKSTR,U,1),1:"0")
|
---|
| 194 | ... W ?45,$S($P(ACKSTR,U,2):$P(ACKSTR,U,2),1:"0")
|
---|
| 195 | ... W ?59,$S($P(ACKSTR,U,3):$P(ACKSTR,U,3),1:"0")
|
---|
| 196 | ...;
|
---|
| 197 | ...; Calculate Totals
|
---|
| 198 | ... S @("ACKCSCT"_AS)=@("ACKCSCT"_AS)+$P(ACKSTR,U,1)
|
---|
| 199 | ... S @("ACKCSTT"_AS)=@("ACKCSTT"_AS)+$P(ACKSTR,U,2)
|
---|
| 200 | ... S @("ACKCSUT"_AS)=@("ACKCSUT"_AS)+$P(ACKSTR,U,3)
|
---|
| 201 | ..;
|
---|
| 202 | .. Q:$D(DIRUT)
|
---|
| 203 | . Q:$D(DIRUT)
|
---|
| 204 | . S $P(LN,"-",80)="" W !,LN
|
---|
| 205 | . W !," "_XAS," Total: ",?32,@("ACKCSCT"_AS),?45,@("ACKCSTT"_AS)
|
---|
| 206 | . W ?59,@("ACKCSUT"_AS),!
|
---|
| 207 | ;
|
---|
| 208 | Q:$D(DIRUT)
|
---|
| 209 | ; Calculate and Display Grand Total for EC
|
---|
| 210 | N ACKGT1,ACKGT2,ACKGT3
|
---|
| 211 | S ACKGT1=$G(ACKCSCTS)+$G(ACKCSCTA)
|
---|
| 212 | S ACKGT2=$G(ACKCSTTS)+$G(ACKCSTTA)
|
---|
| 213 | S ACKGT3=$G(ACKCSUTS)+$G(ACKCSUTA)
|
---|
| 214 | ;
|
---|
| 215 | I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HEADER,ICDCPTHD W !," "_XAS,":"
|
---|
| 216 | W !," Grand Total",?32,ACKGT1,?45,ACKGT2,?59,ACKGT3,!
|
---|
| 217 | ;
|
---|
| 218 | ; D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT)
|
---|
| 219 | Q
|
---|
| 220 | ;
|
---|
| 221 | HEADER ; Display heading of summary report section
|
---|
| 222 | N X
|
---|
| 223 | S ACKPG=ACKPG+1 W @IOF,"Printed: ",ACKCDT,?(IOM-8),"Page: ",ACKPG
|
---|
| 224 | F X="Audiology & Speech Pathology","Capitation Report Summary Report by "_ACKTYPE_" Code",$$XDAT^ACKQUTL(ACKM) W ! D CNTR^ACKQUTL(X)
|
---|
| 225 | W !
|
---|
| 226 | Q
|
---|
| 227 | ;
|
---|
| 228 | ZIPHD ; Display sub heading for ZIP code
|
---|
| 229 | N X
|
---|
| 230 | W !," "_ACKTYPE,?9,"DIVISION",?30,"CLINIC",?43,"TELEPHONE",?58,"UNIQUE"
|
---|
| 231 | W !," EXAMS",?30,"VISITS",?44,"VISITS",?57,"PATIENTS",?71,"C&P"
|
---|
| 232 | D LINE
|
---|
| 233 | Q
|
---|
| 234 | ;
|
---|
| 235 | ICDCPTHD ; Display sub heading for ICD/CPT code
|
---|
| 236 | N X
|
---|
| 237 | W !," "_ACKTYPE,?9,"DIVISION",?30,"CLINIC",?43,"TELEPHONE",?58,"UNIQUE"
|
---|
| 238 | W !," EXAMS",?30,"VISITS",?44,"VISITS",?57,"PATIENTS"
|
---|
| 239 | D LINE
|
---|
| 240 | Q
|
---|
| 241 | ;
|
---|
| 242 | ;
|
---|
| 243 | LINE ; Write line if dashes
|
---|
| 244 | S X="",$P(X,"-",IOM)="-" W !,X
|
---|
| 245 | Q
|
---|
| 246 | ;
|
---|