APCLOSP3 ; IHS/CMI/LAB - AMB PRINT ;
;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
;
;
POV ;
I $Y>(IOSL-15) D HEAD^APCLOSP Q:$D(APCLQUIT)
S APCL1="AMBPOV",APCL2="AMBPOVC",APCLMAX=10,APCLGLOB="^ICD9(",APCLPIEC=3
W !!,"The ten leading purposes of ambulatory visits by individual ICD Code are listed",!,"below. Both primary and secondary diagnoses are included in the counts.",!
;I APCLEXCL,$O(APCLDXT(0)) W "NOTE: These ICD-9 diagnoses have been excluded from this list" S X=0 F S X=$O(APCLDXT(X)) Q:X'=+X W ":",$P(^ICD9(X,0),U) ;cmi/anch/maw 9/10/2007 orig line
I APCLEXCL,$O(APCLDXT(0)) W "NOTE: These ICD diagnoses have been excluded from this list" S X=0 F S X=$O(APCLDXT(X)) Q:X'=+X W ":",$P($$ICDDX^ICDEX(X),U,2) ;cmi/anch/maw 9/10/2007 csv
W !?11,"By ICD Diagnosis"
D PROC
APC ;
G CHART ;no longer do apc groupings
I $Y>(IOSL-12) D HEAD^APCLOSP Q:$D(APCLQUIT)
S APCL1="AMBAPC",APCL2="AMBAPCC",APCLMAX=10,APCLGLOB="^AUTTRCD(",APCLPIEC=3
W !!?11,"By APC Code"
D PROC
CHART ;
I $Y>(IOSL-7) D HEAD^APCLOSP Q:$D(APCLQUIT)
W !!,"CHART REVIEWS"
I '$D(^XTMP("APCLOS",APCLJOB,APCLBTH,"CHART REVIEWS")),'$D(^XTMP("APCLOSP",APCLJOB,APCLBTH,"CHART REVIEWS")) W !?10,"[ NO CHART REVIEWS TO REPORT ]",! G INJURY
S X=$S($D(^XTMP("APCLOS",APCLJOB,APCLBTH,"CHART REVIEWS")):^("CHART REVIEWS"),1:0),Y=$S($D(^XTMP("APCLOSP",APCLJOB,APCLBTH,"CHART REVIEWS")):^("CHART REVIEWS"),1:0) D CALC^APCLOSUT
W !!,"There were ",X," (",Z,") chart reviews performed during this time period.",!
INJURY ;
I $Y>(IOSL-8) D HEAD^APCLOSP Q:$D(APCLQUIT)
S APCL1="AMBINJCAUSE",APCL2="AMBINJCAUSEC",APCLMAX=5,APCLGLOB="^ICD9(",APCLPIEC=3
W !!!,"INJURIES"
I '$D(^XTMP("APCLOS",APCLJOB,APCLBTH,"INJCOUNT")) W !?10,"[ NO INJURY DATA TO REPORT ]",! G ER
S X=$S($D(^XTMP("APCLOS",APCLJOB,APCLBTH,"INJCOUNT")):^("INJCOUNT"),1:0),Y=$S($D(^XTMP("APCLOSP",APCLJOB,APCLBTH,"INJCOUNT")):^("INJCOUNT"),1:0) D CALC^APCLOSUT
I $Y>(IOSL-9) D HEAD^APCLOSP Q:$D(APCLQUIT)
W !!,"There were ",X," visits for injuries (",Z,") reported during this period.",!,"Of these, "
S X=$S($D(^XTMP("APCLOS",APCLJOB,APCLBTH,"INJFIRST")):^XTMP("APCLOS",APCLJOB,APCLBTH,"INJFIRST"),1:0),Y=$S($D(^XTMP("APCLOSP",APCLJOB,APCLBTH,"INJFIRST")):^("INJFIRST"),1:0) D CALC^APCLOSUT
W X," were new injuries (",Z,"). The five leading causes were:"
D PROC
ER ;
I $Y>(IOSL-6) D HEAD^APCLOSP Q:$D(APCLQUIT)
W !!!,"EMERGENCY ROOM"
I '$D(^XTMP("APCLOS",APCLJOB,APCLBTH,"ERCOUNT")) W !?10,"[ NO EMERGENCY ROOM VISITS TO REPORT ]",! G DENTAL
S X=$S($D(^XTMP("APCLOS",APCLJOB,APCLBTH,"ERCOUNT")):^("ERCOUNT"),1:0),Y=$S($D(^XTMP("APCLOSP",APCLJOB,APCLBTH,"ERCOUNT")):^("ERCOUNT"),1:0) D CALC^APCLOSUT
W !!,"There were ",X," visits (",Z,") to the ER (Clinic Code=30). Of these "
S X=$S($D(^XTMP("APCLOS",APCLJOB,APCLBTH,"ERINJCOUNT")):^("ERINJCOUNT"),1:0),Y=$S($D(^XTMP("APCLOSP",APCLJOB,APCLBTH,"ERINJCOUNT")):^("ERINJCOUNT"),1:0) D CALC^APCLOSUT
W !,X," had an injury diagnosis (",Z,") and "
S X=$S($D(^XTMP("APCLOS",APCLJOB,APCLBTH,"ERALCHCOUNT")):^("ERALCHCOUNT"),1:0),Y=$S($D(^XTMP("APCLOSP",APCLJOB,APCLBTH,"ERALCHCOUNT")):^("ERALCHCOUNT"),1:0) D CALC^APCLOSUT
W X," had an alcohol-related",!,"diagnosis (",Z,")."
DENTAL ;
D DENTAL^APCLOSP4
I '$D(^XTMP("APCLOS",APCLJOB,APCLBTH,"DENTPATCOUNT")) Q
D PROC
Q
PROC S (APCLC,APCLN)=0 F S APCLN=$O(^XTMP("APCLOS",APCLJOB,APCLBTH,APCL2,APCLN)) Q:APCLN=""!(APCLC=APCLMAX) D PROC1
Q
PROC1 ;
S APCLD=0 F S APCLD=$O(^XTMP("APCLOS",APCLJOB,APCLBTH,APCL2,APCLN,APCLD)) Q:APCLD=""!(APCLC=APCLMAX) D PROC2
Q
PROC2 ;
S APCLC=APCLC+1
S X=^XTMP("APCLOS",APCLJOB,APCLBTH,APCL2,APCLN,APCLD)
S APCLPD=0 F S APCLPD=$O(^XTMP("APCLOSP",APCLJOB,APCLBTH,APCL1,APCLPD)) Q:APCLD=APCLPD!(APCLPD="")
S Y=$S(APCLPD]"":^XTMP("APCLOSP",APCLJOB,APCLBTH,APCL1,APCLPD),1:0) D CALC^APCLOSUT
S G=APCLGLOB_APCLD_")"
I APCL2'="AMBPOVC",APCL2'="AMBINJCAUSEC" W !?5,APCLC,"). ",?10,$E($P(@G@(0),U,APCLPIEC),1,35),?45,$J(X,7),?56,"(",Z,")" Q
W !?5,APCLC,"). ",?10,$E($P($$ICDDX^ICDEX(APCLD),U,4),1,35),?45,$J(X,7),?56,"(",Z,")"
Q
APCLOSP3 ; IHS/CMI/LAB - AMB PRINT ;
+1 ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
+2 ;
+3 ;
POV ;
+1 IF $Y>(IOSL-15)
DO HEAD^APCLOSP
IF $DATA(APCLQUIT)
QUIT
+2 SET APCL1="AMBPOV"
SET APCL2="AMBPOVC"
SET APCLMAX=10
SET APCLGLOB="^ICD9("
SET APCLPIEC=3
+3 WRITE !!,"The ten leading purposes of ambulatory visits by individual ICD Code are listed",!,"below. Both primary and secondary diagnoses are included in the counts.",!
+4 ;I APCLEXCL,$O(APCLDXT(0)) W "NOTE: These ICD-9 diagnoses have been excluded from this list" S X=0 F S X=$O(APCLDXT(X)) Q:X'=+X W ":",$P(^ICD9(X,0),U) ;cmi/anch/maw 9/10/2007 orig line
+5 ;cmi/anch/maw 9/10/2007 csv
IF APCLEXCL
IF $ORDER(APCLDXT(0))
WRITE "NOTE: These ICD diagnoses have been excluded from this list"
SET X=0
FOR
SET X=$ORDER(APCLDXT(X))
IF X'=+X
QUIT
WRITE ":",$PIECE($$ICDDX^ICDEX(X),U,2)
+6 WRITE !?11,"By ICD Diagnosis"
+7 DO PROC
APC ;
+1 ;no longer do apc groupings
GOTO CHART
+2 IF $Y>(IOSL-12)
DO HEAD^APCLOSP
IF $DATA(APCLQUIT)
QUIT
+3 SET APCL1="AMBAPC"
SET APCL2="AMBAPCC"
SET APCLMAX=10
SET APCLGLOB="^AUTTRCD("
SET APCLPIEC=3
+4 WRITE !!?11,"By APC Code"
+5 DO PROC
CHART ;
+1 IF $Y>(IOSL-7)
DO HEAD^APCLOSP
IF $DATA(APCLQUIT)
QUIT
+2 WRITE !!,"CHART REVIEWS"
+3 IF '$DATA(^XTMP("APCLOS",APCLJOB,APCLBTH,"CHART REVIEWS"))
IF '$DATA(^XTMP("APCLOSP",APCLJOB,APCLBTH,"CHART REVIEWS"))
WRITE !?10,"[ NO CHART REVIEWS TO REPORT ]",!
GOTO INJURY
+4 SET X=$SELECT($DATA(^XTMP("APCLOS",APCLJOB,APCLBTH,"CHART REVIEWS")):^("CHART REVIEWS"),1:0)
SET Y=$SELECT($DATA(^XTMP("APCLOSP",APCLJOB,APCLBTH,"CHART REVIEWS")):^("CHART REVIEWS"),1:0)
DO CALC^APCLOSUT
+5 WRITE !!,"There were ",X," (",Z,") chart reviews performed during this time period.",!
INJURY ;
+1 IF $Y>(IOSL-8)
DO HEAD^APCLOSP
IF $DATA(APCLQUIT)
QUIT
+2 SET APCL1="AMBINJCAUSE"
SET APCL2="AMBINJCAUSEC"
SET APCLMAX=5
SET APCLGLOB="^ICD9("
SET APCLPIEC=3
+3 WRITE !!!,"INJURIES"
+4 IF '$DATA(^XTMP("APCLOS",APCLJOB,APCLBTH,"INJCOUNT"))
WRITE !?10,"[ NO INJURY DATA TO REPORT ]",!
GOTO ER
+5 SET X=$SELECT($DATA(^XTMP("APCLOS",APCLJOB,APCLBTH,"INJCOUNT")):^("INJCOUNT"),1:0)
SET Y=$SELECT($DATA(^XTMP("APCLOSP",APCLJOB,APCLBTH,"INJCOUNT")):^("INJCOUNT"),1:0)
DO CALC^APCLOSUT
+6 IF $Y>(IOSL-9)
DO HEAD^APCLOSP
IF $DATA(APCLQUIT)
QUIT
+7 WRITE !!,"There were ",X," visits for injuries (",Z,") reported during this period.",!,"Of these, "
+8 SET X=$SELECT($DATA(^XTMP("APCLOS",APCLJOB,APCLBTH,"INJFIRST")):^XTMP("APCLOS",APCLJOB,APCLBTH,"INJFIRST"),1:0)
SET Y=$SELECT($DATA(^XTMP("APCLOSP",APCLJOB,APCLBTH,"INJFIRST")):^("INJFIRST"),1:0)
DO CALC^APCLOSUT
+9 WRITE X," were new injuries (",Z,"). The five leading causes were:"
+10 DO PROC
ER ;
+1 IF $Y>(IOSL-6)
DO HEAD^APCLOSP
IF $DATA(APCLQUIT)
QUIT
+2 WRITE !!!,"EMERGENCY ROOM"
+3 IF '$DATA(^XTMP("APCLOS",APCLJOB,APCLBTH,"ERCOUNT"))
WRITE !?10,"[ NO EMERGENCY ROOM VISITS TO REPORT ]",!
GOTO DENTAL
+4 SET X=$SELECT($DATA(^XTMP("APCLOS",APCLJOB,APCLBTH,"ERCOUNT")):^("ERCOUNT"),1:0)
SET Y=$SELECT($DATA(^XTMP("APCLOSP",APCLJOB,APCLBTH,"ERCOUNT")):^("ERCOUNT"),1:0)
DO CALC^APCLOSUT
+5 WRITE !!,"There were ",X," visits (",Z,") to the ER (Clinic Code=30). Of these "
+6 SET X=$SELECT($DATA(^XTMP("APCLOS",APCLJOB,APCLBTH,"ERINJCOUNT")):^("ERINJCOUNT"),1:0)
SET Y=$SELECT($DATA(^XTMP("APCLOSP",APCLJOB,APCLBTH,"ERINJCOUNT")):^("ERINJCOUNT"),1:0)
DO CALC^APCLOSUT
+7 WRITE !,X," had an injury diagnosis (",Z,") and "
+8 SET X=$SELECT($DATA(^XTMP("APCLOS",APCLJOB,APCLBTH,"ERALCHCOUNT")):^("ERALCHCOUNT"),1:0)
SET Y=$SELECT($DATA(^XTMP("APCLOSP",APCLJOB,APCLBTH,"ERALCHCOUNT")):^("ERALCHCOUNT"),1:0)
DO CALC^APCLOSUT
+9 WRITE X," had an alcohol-related",!,"diagnosis (",Z,")."
DENTAL ;
+1 DO DENTAL^APCLOSP4
+2 IF '$DATA(^XTMP("APCLOS",APCLJOB,APCLBTH,"DENTPATCOUNT"))
QUIT
+3 DO PROC
+4 QUIT
PROC SET (APCLC,APCLN)=0
FOR
SET APCLN=$ORDER(^XTMP("APCLOS",APCLJOB,APCLBTH,APCL2,APCLN))
IF APCLN=""!(APCLC=APCLMAX)
QUIT
DO PROC1
+1 QUIT
PROC1 ;
+1 SET APCLD=0
FOR
SET APCLD=$ORDER(^XTMP("APCLOS",APCLJOB,APCLBTH,APCL2,APCLN,APCLD))
IF APCLD=""!(APCLC=APCLMAX)
QUIT
DO PROC2
+2 QUIT
PROC2 ;
+1 SET APCLC=APCLC+1
+2 SET X=^XTMP("APCLOS",APCLJOB,APCLBTH,APCL2,APCLN,APCLD)
+3 SET APCLPD=0
FOR
SET APCLPD=$ORDER(^XTMP("APCLOSP",APCLJOB,APCLBTH,APCL1,APCLPD))
IF APCLD=APCLPD!(APCLPD="")
QUIT
+4 SET Y=$SELECT(APCLPD]"":^XTMP("APCLOSP",APCLJOB,APCLBTH,APCL1,APCLPD),1:0)
DO CALC^APCLOSUT
+5 SET G=APCLGLOB_APCLD_")"
+6 IF APCL2'="AMBPOVC"
IF APCL2'="AMBINJCAUSEC"
WRITE !?5,APCLC,"). ",?10,$EXTRACT($PIECE(@G@(0),U,APCLPIEC),1,35),?45,$JUSTIFY(X,7),?56,"(",Z,")"
QUIT
+7 WRITE !?5,APCLC,"). ",?10,$EXTRACT($PIECE($$ICDDX^ICDEX(APCLD),U,4),1,35),?45,$JUSTIFY(X,7),?56,"(",Z,")"
+8 QUIT
