APCLCARQ ; IHS/CMI/LAB - California Report ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
;
PRINT ;
S APCLH1="Principal Service"
D HEADER
W !?5,"Evaluation and Management Services"
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"1",?6,"Evaluation and Management (new patient)",?54,"99201-99205",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",1)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"2",?6,"Evaluation and Management (established patient)",?54,"99211-99215",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",2)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"3",?6,"Hospital Related Services",?54,"99217-99223",!?54,"99231-99239",!?54,"99477",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",3)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"4",?6,"Consultations",?54,"99241-99255",!?54,"99441-99444",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",4)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !?54,"99291-99292"
W !?54,"99354-99360"
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"5",?6,"Other Evaluation and Management Services",?54,"99450",!?54,"99455-99456",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",5)),0,8)
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,?54,"99499" D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"6",?6,"Nursing Facility Related Services",?54,"99304-99318",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",6)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"7",?6,"Case Management Services",?54,"99363-99368",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",7)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,?54,"99381-99384"
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"8",?6,"Preventive Medicine (infant,child,adolescent)",?54,"99391-99394",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",8)),0,8)
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,?54,"99431-99440" D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !?54,"99385-99387"
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"9",?6,"Preventive Medicine (adults)",?54,"99395-99397",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",9)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"10",?6,"Counseling",?54,"99401-99429",!?54,"99605-99607",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",10)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,?5,"All Other Services"
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"11",?6,"Anesthesia",?54,"00100-01999",!?54,"99100, 99116",!?54,"99135, 99140"
W !?54,"99143-99150",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",11)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"12",?6,"Integumentary System",?54,"10021-19499",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",12)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"13",?6,"Musculoskeletal System",?54,"20000-29999",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",13)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"14",?6,"Respiratory System",?54,"30000-32999",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",14)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"15",?6,"Cardiovascular System",?54,"33010-37799",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",15)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"16",?6,"Hemic and Lymphatic System",?54,"38100-38999",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",16)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"17",?6,"Mediastinum and Diaphragm System",?54,"39000-39599",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",17)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"18",?6,"Digestive System",?54,"40490-49999",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",18)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"19",?6,"Urinary System",?54,"50010-53899",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",19)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"20",?6,"Male Genital System",?54,"54000-55899",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",20)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"21",?6,"Intersex Surgery",?54,"55970, 55980",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",21)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"22",?6,"Female Genital System",?54,"56405-58999",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",22)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"23",?6,"Maternity Care and Delivery",?54,"59000-59899",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",23)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"24",?6,"Endocrine System",?54,"60000-60699",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",24)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"25",?6,"Nervous System",?54,"61000-64999",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",25)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"26",?6,"Eye and Ocular Adnexa System",?54,"65091-68899",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",26)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"27",?6,"Auditory System",?54,"69000-69990",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",27)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"28",?6,"Radiologyic and Lymphatic System",?54,"70010-79999",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",28)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"29",?6,"Pathology/Laboratory",?54,"80047-89356",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",29)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"30",?6,"Medicine - Special Services",?54,"90281-99091",!?54,"99170-99199",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",30)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"31",?6,"Family Planning 'Z' Codes",?54,"'Z' Codes",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",31)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"32",?6,"Dental Encounters",?54,"cdt codes",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",32)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"33",?6,"Category III Codes",?54,"0016T-9999T",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",33)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"44",?6,"All Other encounters",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",44)),0,8) D L
W !,"45",?6,"Total",?68,$$C(APCLTOTR,0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !!,"Visits with NO CPT Codes",?72,$$C(APCLNCPT,0,8)
SPEC ;
S APCLH1="Selected Principal Service" D HEADER Q:APCLQUIT
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
;W !?54,"76082-76083"
W !,"50",?6,"Mammogram",?54,"77051-77059",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",50)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !?54,"86689, 86701-86703"
W !,"51",?6,"HIV Testing",?54,"87390-87391",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",51)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !?54,"88141-88155"
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"52",?6,"Pap Smear",?54,"88164-88167",!?54,"88174-88175",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",52)),0,8) D L
;W !?54,"88174-88175"
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !?54,"11975-11977"
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !?54,"55250,55450,57170"
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"53",?6,"Contraceptive Management",?54,"58300-58301",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",53)),0,8)
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !?54,"58600-58611",!?54,"58670-58671" D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,?5,"Vaccinations:" D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"60",?6,"DTAP, DTP, Diphtheria",?54,"90698,90700-90703,"
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !?54,"90714-90715"
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !?54,"90718-90723",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",60)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"61",?6,"Hemophilus Influenza B (Hib)",?54,"90645-90648",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",61)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"62",?6,"Hepatitis A",?54,"90632-90634",!?54,"90636",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",62)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"63",?6,"Hepatitis B or HepB-HIB",?54,"90740-90747",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",63)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"64",?6,"HepB and Hib",?54,"90748",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",64)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"65",?6,"Influenza Virus Vaccine",?54,"90655-90658",!?54,"90660",!?54,"90661-90663",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",65)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"66",?6,"Measles, Mumps, Rubella"
W !,?6,"and Varicella (MMRV)",?54,"90704-90708",!?54,"90710",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",66)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"67",?6,"Pneumococcal",?54,"90669,90732",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",67)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"68",?6,"Poliovirus",?54,"90712-90713",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",68)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"69",?6,"Varicella",?54,"90716",?68,$$C($G(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",69)),0,8) D L
I $Y>(IOSL-4) D HEADER Q:APCLQUIT
W !,"75",?6,"Total Selected Encounters",?68,$$C(APCLSPE1+APCLSPE2,0,8) D L
EOJ ;
;K ^XTMP("APCLCAR",APCLJ,APCLH)
K N,%,T,F,X,Y,B,C,E,F,H,L,N,P,T,W
Q
C(X,X2,X3) ;
D COMMA^%DTC
Q X
G:'APCLPG HEAD1
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCLQUIT=1 Q
HEAD1 ;
W:$D(IOF) @IOF S APCLPG=APCLPG+1
W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",APCLPG,!
W !,$$CTR("*** CALIFORNIA ANNUAL UTILIZATION REPORT OF PRIMARY CARE CLINICS, 2008 ***",80),!
;W $$CTR($P(^DIC(4,DUZ(2),0),U)),!
I '$D(APCLLOCT) S X="ALL LOCATIONS OF ENCOUNTER SELECTED" W $$CTR(X,80),!
I $D(APCLLOCT) D
.S X="Locations Selected:"
.S Y=0 F S Y=$O(APCLLOCT(Y)) Q:Y'=+Y S X=X_" "_$P(^DIC(4,Y,0),U)
.W X,!
S X="Reporting Period: "_$$FMTE^XLFDT(APCLBD)_" to "_$$FMTE^XLFDT(APCLED) W $$CTR(X,80),!
W !,"ENCOUNTERS BY PRINCIPAL SERVICE - SECTION 5"
W !,$TR($J("",80)," ","_")
W !,"Line",?54,"2006",?68,"(1) No."
W !,"No.",?7,APCLH1,?54,"CPT Codes",?68,"of Encs",!
W !,$TR($J("",80)," ","_")
Q
L ;
W !,$TR($J("",80)," ","_")
Q
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
;
APCLCARQ ; IHS/CMI/LAB - California Report ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
+3 ;
PRINT ;
+1 SET APCLH1="Principal Service"
+2 DO HEADER
+3 WRITE !?5,"Evaluation and Management Services"
+4 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+5 WRITE !,"1",?6,"Evaluation and Management (new patient)",?54,"99201-99205",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",1)),0,8)
DO L
+6 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+7 WRITE !,"2",?6,"Evaluation and Management (established patient)",?54,"99211-99215",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",2)),0,8)
DO L
+8 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+9 WRITE !,"3",?6,"Hospital Related Services",?54,"99217-99223",!?54,"99231-99239",!?54,"99477",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",3)),0,8)
DO L
+10 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+11 WRITE !,"4",?6,"Consultations",?54,"99241-99255",!?54,"99441-99444",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",4)),0,8)
DO L
+12 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+13 WRITE !?54,"99291-99292"
+14 WRITE !?54,"99354-99360"
+15 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+16 WRITE !,"5",?6,"Other Evaluation and Management Services",?54,"99450",!?54,"99455-99456",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",5)),0,8)
+17 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+18 WRITE !,?54,"99499"
DO L
+19 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+20 WRITE !,"6",?6,"Nursing Facility Related Services",?54,"99304-99318",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",6)),0,8)
DO L
+21 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+22 WRITE !,"7",?6,"Case Management Services",?54,"99363-99368",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",7)),0,8)
DO L
+23 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+24 WRITE !,?54,"99381-99384"
+25 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+26 WRITE !,"8",?6,"Preventive Medicine (infant,child,adolescent)",?54,"99391-99394",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",8)),0,8)
+27 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+28 WRITE !,?54,"99431-99440"
DO L
+29 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+30 WRITE !?54,"99385-99387"
+31 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+32 WRITE !,"9",?6,"Preventive Medicine (adults)",?54,"99395-99397",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",9)),0,8)
DO L
+33 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+34 WRITE !,"10",?6,"Counseling",?54,"99401-99429",!?54,"99605-99607",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",10)),0,8)
DO L
+35 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+36 WRITE !,?5,"All Other Services"
+37 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+38 WRITE !,"11",?6,"Anesthesia",?54,"00100-01999",!?54,"99100, 99116",!?54,"99135, 99140"
+39 WRITE !?54,"99143-99150",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",11)),0,8)
DO L
+40 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+41 WRITE !,"12",?6,"Integumentary System",?54,"10021-19499",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",12)),0,8)
DO L
+42 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+43 WRITE !,"13",?6,"Musculoskeletal System",?54,"20000-29999",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",13)),0,8)
DO L
+44 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+45 WRITE !,"14",?6,"Respiratory System",?54,"30000-32999",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",14)),0,8)
DO L
+46 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+47 WRITE !,"15",?6,"Cardiovascular System",?54,"33010-37799",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",15)),0,8)
DO L
+48 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+49 WRITE !,"16",?6,"Hemic and Lymphatic System",?54,"38100-38999",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",16)),0,8)
DO L
+50 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+51 WRITE !,"17",?6,"Mediastinum and Diaphragm System",?54,"39000-39599",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",17)),0,8)
DO L
+52 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+53 WRITE !,"18",?6,"Digestive System",?54,"40490-49999",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",18)),0,8)
DO L
+54 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+55 WRITE !,"19",?6,"Urinary System",?54,"50010-53899",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",19)),0,8)
DO L
+56 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+57 WRITE !,"20",?6,"Male Genital System",?54,"54000-55899",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",20)),0,8)
DO L
+58 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+59 WRITE !,"21",?6,"Intersex Surgery",?54,"55970, 55980",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",21)),0,8)
DO L
+60 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+61 WRITE !,"22",?6,"Female Genital System",?54,"56405-58999",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",22)),0,8)
DO L
+62 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+63 WRITE !,"23",?6,"Maternity Care and Delivery",?54,"59000-59899",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",23)),0,8)
DO L
+64 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+65 WRITE !,"24",?6,"Endocrine System",?54,"60000-60699",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",24)),0,8)
DO L
+66 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+67 WRITE !,"25",?6,"Nervous System",?54,"61000-64999",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",25)),0,8)
DO L
+68 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+69 WRITE !,"26",?6,"Eye and Ocular Adnexa System",?54,"65091-68899",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",26)),0,8)
DO L
+70 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+71 WRITE !,"27",?6,"Auditory System",?54,"69000-69990",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",27)),0,8)
DO L
+72 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+73 WRITE !,"28",?6,"Radiologyic and Lymphatic System",?54,"70010-79999",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",28)),0,8)
DO L
+74 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+75 WRITE !,"29",?6,"Pathology/Laboratory",?54,"80047-89356",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",29)),0,8)
DO L
+76 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+77 WRITE !,"30",?6,"Medicine - Special Services",?54,"90281-99091",!?54,"99170-99199",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",30)),0,8)
DO L
+78 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+79 WRITE !,"31",?6,"Family Planning 'Z' Codes",?54,"'Z' Codes",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",31)),0,8)
DO L
+80 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+81 WRITE !,"32",?6,"Dental Encounters",?54,"cdt codes",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",32)),0,8)
DO L
+82 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+83 WRITE !,"33",?6,"Category III Codes",?54,"0016T-9999T",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",33)),0,8)
DO L
+84 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+85 WRITE !,"44",?6,"All Other encounters",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",44)),0,8)
DO L
+86 WRITE !,"45",?6,"Total",?68,$$C(APCLTOTR,0,8)
DO L
+87 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+88 WRITE !!,"Visits with NO CPT Codes",?72,$$C(APCLNCPT,0,8)
SPEC ;
+1 SET APCLH1="Selected Principal Service"
DO HEADER
IF APCLQUIT
QUIT
+2 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+3 ;W !?54,"76082-76083"
+4 WRITE !,"50",?6,"Mammogram",?54,"77051-77059",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",50)),0,8)
DO L
+5 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+6 WRITE !?54,"86689, 86701-86703"
+7 WRITE !,"51",?6,"HIV Testing",?54,"87390-87391",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",51)),0,8)
DO L
+8 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+9 WRITE !?54,"88141-88155"
+10 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+11 WRITE !,"52",?6,"Pap Smear",?54,"88164-88167",!?54,"88174-88175",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",52)),0,8)
DO L
+12 ;W !?54,"88174-88175"
+13 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+14 WRITE !?54,"11975-11977"
+15 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+16 WRITE !?54,"55250,55450,57170"
+17 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+18 WRITE !,"53",?6,"Contraceptive Management",?54,"58300-58301",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",53)),0,8)
+19 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+20 WRITE !?54,"58600-58611",!?54,"58670-58671"
DO L
+21 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+22 WRITE !,?5,"Vaccinations:"
DO L
+23 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+24 WRITE !,"60",?6,"DTAP, DTP, Diphtheria",?54,"90698,90700-90703,"
+25 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+26 WRITE !?54,"90714-90715"
+27 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+28 WRITE !?54,"90718-90723",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",60)),0,8)
DO L
+29 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+30 WRITE !,"61",?6,"Hemophilus Influenza B (Hib)",?54,"90645-90648",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",61)),0,8)
DO L
+31 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+32 WRITE !,"62",?6,"Hepatitis A",?54,"90632-90634",!?54,"90636",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",62)),0,8)
DO L
+33 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+34 WRITE !,"63",?6,"Hepatitis B or HepB-HIB",?54,"90740-90747",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",63)),0,8)
DO L
+35 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+36 WRITE !,"64",?6,"HepB and Hib",?54,"90748",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",64)),0,8)
DO L
+37 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+38 WRITE !,"65",?6,"Influenza Virus Vaccine",?54,"90655-90658",!?54,"90660",!?54,"90661-90663",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",65)),0,8)
DO L
+39 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+40 WRITE !,"66",?6,"Measles, Mumps, Rubella"
+41 WRITE !,?6,"and Varicella (MMRV)",?54,"90704-90708",!?54,"90710",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",66)),0,8)
DO L
+42 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+43 WRITE !,"67",?6,"Pneumococcal",?54,"90669,90732",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",67)),0,8)
DO L
+44 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+45 WRITE !,"68",?6,"Poliovirus",?54,"90712-90713",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",68)),0,8)
DO L
+46 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+47 WRITE !,"69",?6,"Varicella",?54,"90716",?68,$$C($GET(^XTMP("APCLCAR",APCLJ,APCLH,"CPT",69)),0,8)
DO L
+48 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+49 WRITE !,"75",?6,"Total Selected Encounters",?68,$$C(APCLSPE1+APCLSPE2,0,8)
DO L
EOJ ;
+1 ;K ^XTMP("APCLCAR",APCLJ,APCLH)
+2 KILL N,%,T,F,X,Y,B,C,E,F,H,L,N,P,T,W
+3 QUIT
C(X,X2,X3) ;
+1 DO COMMA^%DTC
+2 QUIT X
+1 IF 'APCLPG
GOTO HEAD1
+2 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET APCLQUIT=1
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET APCLPG=APCLPG+1
+2 WRITE !?3,$PIECE(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",APCLPG,!
+3 WRITE !,$$CTR("*** CALIFORNIA ANNUAL UTILIZATION REPORT OF PRIMARY CARE CLINICS, 2008 ***",80),!
+4 ;W $$CTR($P(^DIC(4,DUZ(2),0),U)),!
+5 IF '$DATA(APCLLOCT)
SET X="ALL LOCATIONS OF ENCOUNTER SELECTED"
WRITE $$CTR(X,80),!
+6 IF $DATA(APCLLOCT)
Begin DoDot:1
+7 SET X="Locations Selected:"
+8 SET Y=0
FOR
SET Y=$ORDER(APCLLOCT(Y))
IF Y'=+Y
QUIT
SET X=X_" "_$PIECE(^DIC(4,Y,0),U)
+9 WRITE X,!
End DoDot:1
+10 SET X="Reporting Period: "_$$FMTE^XLFDT(APCLBD)_" to "_$$FMTE^XLFDT(APCLED)
WRITE $$CTR(X,80),!
+11 WRITE !,"ENCOUNTERS BY PRINCIPAL SERVICE - SECTION 5"
+12 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","_")
+13 WRITE !,"Line",?54,"2006",?68,"(1) No."
+14 WRITE !,"No.",?7,APCLH1,?54,"CPT Codes",?68,"of Encs",!
+15 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","_")
+16 QUIT
L ;
+1 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","_")
+2 QUIT
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;----------
+3 ;
