- 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
