APCLOSP1 ; IHS/CMI/LAB - CONTINUATION OF APCLOSP1 ; 01 Nov 2010 11:33 AM
;;2.0;IHS PCC SUITE;**5,11**;MAY 14, 2009;Build 58
;IHS/CMI/LAB - patch 4 fixed newborn display
;cmi/anch/maw 9/10/2007 code set versioning in INPT2, ADMDX2
;
INPT ;
I $Y>(IOSL-10) D HEAD^APCLOSP Q:$D(APCLQUIT)
W !!,"DIRECT INPATIENT"
I '$D(^XTMP("APCLOS",APCLJOB,APCLBTH,"DISCH")),'$D(^XTMP("APCLOSP",APCLJOB,APCLBTH,"DISCH")) W !?10,"[ NO DIRECT INPATIENT DATA TO REPORT ]",! Q
S X=$S($D(^XTMP("APCLOS",APCLJOB,APCLBTH,"DISCH")):^("DISCH"),1:0),Y=$S($D(^XTMP("APCLOSP",APCLJOB,APCLBTH,"DISCH")):^("DISCH"),1:0) D CALC^APCLOSUT
W !!,"There were ",X," discharges (",Z,") during this period, accounting for"
S X=$S($D(^XTMP("APCLOS",APCLJOB,APCLBTH,"PATDAYS")):^("PATDAYS"),1:0),Y=$S($D(^XTMP("APCLOSP",APCLJOB,APCLBTH,"PATDAYS")):^("PATDAYS"),1:0) D CALC^APCLOSUT
W !,X," patient days (",Z,"). The average length of stay was "
S X=$S($D(^XTMP("APCLOS",APCLJOB,APCLBTH,"ALOS")):^("ALOS"),1:0),Y=$S($D(^XTMP("APCLOSP",APCLJOB,APCLBTH,"ALOS")):^("ALOS"),1:0) D CALC^APCLOSUT
W X," days compared",!,"to an ALOS of ",Y," during this period last year."
I $Y>(IOSL-10) D HEAD^APCLOSP Q:$D(APCLQUIT)
;IHS/TUCSON/LAB - fixed APCLNBC and APCLNBDY
I APCLNBC("APCLOS")>0 W !!,"In addition, there ",$S(APCLNBC("APCLOS")>1:"were",1:"was")," ",APCLNBC("APCLOS")," newborn discharge",$S(APCLNBC("APCLOS")>1:"s",1:"")," accounting",!,"for ",APCLNBDY("APCLOS")," days."
W !!,"The Five leading primary diagnoses for hospitalizations were:",!
S (APCLC,APCLN)=0 F S APCLN=$O(^XTMP("APCLOS",APCLJOB,APCLBTH,"INPTPOVC",APCLN)) Q:APCLN=""!(APCLC=5) D INPT1
I $Y>(IOSL-5) D HEAD^APCLOSP Q:$D(APCLQUIT)
W !!,"The Top Ten admitting diagnoses for hospitalizations were:",!
S (APCLC,APCLN)=0 F S APCLN=$O(^XTMP("APCLOS",APCLJOB,APCLBTH,"INPTADMDXC",APCLN)) Q:APCLN=""!(APCLC=10) D ADMDX1
Q
INPT1 ;
S APCLD=0 F S APCLD=$O(^XTMP("APCLOS",APCLJOB,APCLBTH,"INPTPOVC",APCLN,APCLD)) Q:APCLD=""!(APCLC=5) D INPT2
Q
INPT2 ;
Q:'$D(^ICD9(APCLD))
S APCLC=APCLC+1
S X=^XTMP("APCLOS",APCLJOB,APCLBTH,"INPTPOVC",APCLN,APCLD)
S APCLPD=0 F S APCLPD=$O(^XTMP("APCLOSP",APCLJOB,APCLBTH,"INPTPOV",APCLPD)) Q:APCLD=APCLPD!(APCLPD="")
S Y=$S(APCLPD]"":^XTMP("APCLOSP",APCLJOB,APCLBTH,"INPTPOV",APCLPD),1:0) D CALC^APCLOSUT
;W !?5,APCLC,"). ",?10,$P(^ICD9(APCLD,0),U,3),?45,X,?52,"(",Z,")" ;cmi/anch/maw 9/10/2007 orig line
W !?5,APCLC,"). ",?10,$E($P($$ICDDX^ICDEX(APCLD),U,4),1,32),?45,X,?52,"(",Z,")" ;cmi/anch/maw 9/10/2007 csv
Q
ADMDX1 ;
S APCLD=0 F S APCLD=$O(^XTMP("APCLOS",APCLJOB,APCLBTH,"INPTADMDXC",APCLN,APCLD)) Q:APCLD=""!(APCLC=10)!($D(APCLQUIT)) D ADMDX2
Q
ADMDX2 ;
Q:'$D(^ICD9(APCLD))
S APCLC=APCLC+1
S X=^XTMP("APCLOS",APCLJOB,APCLBTH,"INPTADMDXC",APCLN,APCLD)
S APCLPD=0 F S APCLPD=$O(^XTMP("APCLOSP",APCLJOB,APCLBTH,"INPTADMDX",APCLPD)) Q:APCLD=APCLPD!(APCLPD="")
S Y=$S(APCLPD]"":^XTMP("APCLOSP",APCLJOB,APCLBTH,"INPTADMDX",APCLPD),1:0) D CALC^APCLOSUT
;W !?5,APCLC,"). ",?10,$P(^ICD9(APCLD,0),U,3),?45,X,?52,"(",Z,")" ;cmi/anch/maw 9/10/2007 orig line
W !?5,APCLC,"). ",?10,$E($P($$ICDDX^ICDEX(APCLD),U,4),1,32),?45,X,?52,"(",Z,")" ;cmi/anch/maw 9/10/2007 csv
Q
RX ;
I $Y>(IOSL-6) D HEAD^APCLOSP Q:$D(APCLQUIT)
W !!,"PHARMACY"
I '$D(^XTMP("APCLOS",APCLJOB,APCLBTH,"RXNEW")),'$D(^XTMP("APCLOS",APCLJOB,APCLBTH,"RXREFILLS")) W !?10,"[ NO PHARMACY DATA TO REPORT ]",! Q
S X=$S($D(^XTMP("APCLOS",APCLJOB,APCLBTH,"RXNEW")):^("RXNEW"),1:0),Y=$S($D(^XTMP("APCLOSP",APCLJOB,APCLBTH,"RXNEW")):^("RXNEW"),1:0) D CALC^APCLOSUT
W !!,"There were ",X," new prescriptions (",Z,") and "
S X=$S($D(^XTMP("APCLOS",APCLJOB,APCLBTH,"RXREFILLS")):^("RXREFILLS"),1:0),Y=$S($D(^XTMP("APCLOSP",APCLJOB,APCLBTH,"RXREFILLS")):^("RXREFILLS"),1:0) D CALC^APCLOSUT
W X," refills (",Z,")",!,"during this period."
Q
CHS ;
I $Y>(IOSL-10) D HEAD^APCLOSP Q:$D(APCLQUIT)
W !!,"CONTRACT HEALTH SERVICES"
I '$D(^XTMP("APCLOS",APCLJOB,APCLBTH,"CHSTOTAL")) W !?10,"[ NO CHS DATA TO REPORT ]",! Q
S X=$S($D(^XTMP("APCLOS",APCLJOB,APCLBTH,"CHSTOTAL")):^("CHSTOTAL"),1:0),Y=$S($D(^XTMP("APCLOSP",APCLJOB,APCLBTH,"CHSTOTAL")):^("CHSTOTAL"),1:0) D CALC^APCLOSUT
W !!,"Total CHS expenditures (obligations adjusted by payments) for this period were",!,X," (",Z,"). The number and dollar amount of authorizations by type were:",!
S APCLN=0 F S APCLN=$O(^XTMP("APCLOS",APCLJOB,APCLBTH,"CHS",APCLN)) Q:APCLN="" D CHS1
Q
CHS1 ;
S APCLTYPE="" F S APCLTYPE=$O(^XTMP("APCLOS",APCLJOB,APCLBTH,"CHS",APCLN,APCLTYPE)) Q:APCLTYPE="" D CHS2
Q
CHS2 ;
S X=$S($D(^XTMP("APCLOS",APCLJOB,APCLBTH,"CHS",APCLN,APCLTYPE)):^(APCLTYPE),1:0),Y=$S($D(^XTMP("APCLOSP",APCLJOB,APCLBTH,"CHS",APCLN,APCLTYPE)):^(APCLTYPE),1:0) D CALC^APCLOSUT
W !?5,APCLTYPE,?40,^XTMP("APCLOS",APCLJOB,APCLBTH,"CHSCOUNT",APCLN,APCLTYPE),?50,^XTMP("APCLOS",APCLJOB,APCLBTH,"CHS",APCLN,APCLTYPE)
Q
APCLOSP1 ; IHS/CMI/LAB - CONTINUATION OF APCLOSP1 ; 01 Nov 2010 11:33 AM
+1 ;;2.0;IHS PCC SUITE;**5,11**;MAY 14, 2009;Build 58
+2 ;IHS/CMI/LAB - patch 4 fixed newborn display
+3 ;cmi/anch/maw 9/10/2007 code set versioning in INPT2, ADMDX2
+4 ;
INPT ;
+1 IF $Y>(IOSL-10)
DO HEAD^APCLOSP
IF $DATA(APCLQUIT)
QUIT
+2 WRITE !!,"DIRECT INPATIENT"
+3 IF '$DATA(^XTMP("APCLOS",APCLJOB,APCLBTH,"DISCH"))
IF '$DATA(^XTMP("APCLOSP",APCLJOB,APCLBTH,"DISCH"))
WRITE !?10,"[ NO DIRECT INPATIENT DATA TO REPORT ]",!
QUIT
+4 SET X=$SELECT($DATA(^XTMP("APCLOS",APCLJOB,APCLBTH,"DISCH")):^("DISCH"),1:0)
SET Y=$SELECT($DATA(^XTMP("APCLOSP",APCLJOB,APCLBTH,"DISCH")):^("DISCH"),1:0)
DO CALC^APCLOSUT
+5 WRITE !!,"There were ",X," discharges (",Z,") during this period, accounting for"
+6 SET X=$SELECT($DATA(^XTMP("APCLOS",APCLJOB,APCLBTH,"PATDAYS")):^("PATDAYS"),1:0)
SET Y=$SELECT($DATA(^XTMP("APCLOSP",APCLJOB,APCLBTH,"PATDAYS")):^("PATDAYS"),1:0)
DO CALC^APCLOSUT
+7 WRITE !,X," patient days (",Z,"). The average length of stay was "
+8 SET X=$SELECT($DATA(^XTMP("APCLOS",APCLJOB,APCLBTH,"ALOS")):^("ALOS"),1:0)
SET Y=$SELECT($DATA(^XTMP("APCLOSP",APCLJOB,APCLBTH,"ALOS")):^("ALOS"),1:0)
DO CALC^APCLOSUT
+9 WRITE X," days compared",!,"to an ALOS of ",Y," during this period last year."
+10 IF $Y>(IOSL-10)
DO HEAD^APCLOSP
IF $DATA(APCLQUIT)
QUIT
+11 ;IHS/TUCSON/LAB - fixed APCLNBC and APCLNBDY
+12 IF APCLNBC("APCLOS")>0
WRITE !!,"In addition, there ",$SELECT(APCLNBC("APCLOS")>1:"were",1:"was")," ",APCLNBC("APCLOS")," newborn discharge",$SELECT(APCLNBC("APCLOS")>1:"s",1:"")," accounting",!,"for ",APCLNBDY("APCLOS")," days."
+13 WRITE !!,"The Five leading primary diagnoses for hospitalizations were:",!
+14 SET (APCLC,APCLN)=0
FOR
SET APCLN=$ORDER(^XTMP("APCLOS",APCLJOB,APCLBTH,"INPTPOVC",APCLN))
IF APCLN=""!(APCLC=5)
QUIT
DO INPT1
+15 IF $Y>(IOSL-5)
DO HEAD^APCLOSP
IF $DATA(APCLQUIT)
QUIT
+16 WRITE !!,"The Top Ten admitting diagnoses for hospitalizations were:",!
+17 SET (APCLC,APCLN)=0
FOR
SET APCLN=$ORDER(^XTMP("APCLOS",APCLJOB,APCLBTH,"INPTADMDXC",APCLN))
IF APCLN=""!(APCLC=10)
QUIT
DO ADMDX1
+18 QUIT
INPT1 ;
+1 SET APCLD=0
FOR
SET APCLD=$ORDER(^XTMP("APCLOS",APCLJOB,APCLBTH,"INPTPOVC",APCLN,APCLD))
IF APCLD=""!(APCLC=5)
QUIT
DO INPT2
+2 QUIT
INPT2 ;
+1 IF '$DATA(^ICD9(APCLD))
QUIT
+2 SET APCLC=APCLC+1
+3 SET X=^XTMP("APCLOS",APCLJOB,APCLBTH,"INPTPOVC",APCLN,APCLD)
+4 SET APCLPD=0
FOR
SET APCLPD=$ORDER(^XTMP("APCLOSP",APCLJOB,APCLBTH,"INPTPOV",APCLPD))
IF APCLD=APCLPD!(APCLPD="")
QUIT
+5 SET Y=$SELECT(APCLPD]"":^XTMP("APCLOSP",APCLJOB,APCLBTH,"INPTPOV",APCLPD),1:0)
DO CALC^APCLOSUT
+6 ;W !?5,APCLC,"). ",?10,$P(^ICD9(APCLD,0),U,3),?45,X,?52,"(",Z,")" ;cmi/anch/maw 9/10/2007 orig line
+7 ;cmi/anch/maw 9/10/2007 csv
WRITE !?5,APCLC,"). ",?10,$EXTRACT($PIECE($$ICDDX^ICDEX(APCLD),U,4),1,32),?45,X,?52,"(",Z,")"
+8 QUIT
ADMDX1 ;
+1 SET APCLD=0
FOR
SET APCLD=$ORDER(^XTMP("APCLOS",APCLJOB,APCLBTH,"INPTADMDXC",APCLN,APCLD))
IF APCLD=""!(APCLC=10)!($DATA(APCLQUIT))
QUIT
DO ADMDX2
+2 QUIT
ADMDX2 ;
+1 IF '$DATA(^ICD9(APCLD))
QUIT
+2 SET APCLC=APCLC+1
+3 SET X=^XTMP("APCLOS",APCLJOB,APCLBTH,"INPTADMDXC",APCLN,APCLD)
+4 SET APCLPD=0
FOR
SET APCLPD=$ORDER(^XTMP("APCLOSP",APCLJOB,APCLBTH,"INPTADMDX",APCLPD))
IF APCLD=APCLPD!(APCLPD="")
QUIT
+5 SET Y=$SELECT(APCLPD]"":^XTMP("APCLOSP",APCLJOB,APCLBTH,"INPTADMDX",APCLPD),1:0)
DO CALC^APCLOSUT
+6 ;W !?5,APCLC,"). ",?10,$P(^ICD9(APCLD,0),U,3),?45,X,?52,"(",Z,")" ;cmi/anch/maw 9/10/2007 orig line
+7 ;cmi/anch/maw 9/10/2007 csv
WRITE !?5,APCLC,"). ",?10,$EXTRACT($PIECE($$ICDDX^ICDEX(APCLD),U,4),1,32),?45,X,?52,"(",Z,")"
+8 QUIT
RX ;
+1 IF $Y>(IOSL-6)
DO HEAD^APCLOSP
IF $DATA(APCLQUIT)
QUIT
+2 WRITE !!,"PHARMACY"
+3 IF '$DATA(^XTMP("APCLOS",APCLJOB,APCLBTH,"RXNEW"))
IF '$DATA(^XTMP("APCLOS",APCLJOB,APCLBTH,"RXREFILLS"))
WRITE !?10,"[ NO PHARMACY DATA TO REPORT ]",!
QUIT
+4 SET X=$SELECT($DATA(^XTMP("APCLOS",APCLJOB,APCLBTH,"RXNEW")):^("RXNEW"),1:0)
SET Y=$SELECT($DATA(^XTMP("APCLOSP",APCLJOB,APCLBTH,"RXNEW")):^("RXNEW"),1:0)
DO CALC^APCLOSUT
+5 WRITE !!,"There were ",X," new prescriptions (",Z,") and "
+6 SET X=$SELECT($DATA(^XTMP("APCLOS",APCLJOB,APCLBTH,"RXREFILLS")):^("RXREFILLS"),1:0)
SET Y=$SELECT($DATA(^XTMP("APCLOSP",APCLJOB,APCLBTH,"RXREFILLS")):^("RXREFILLS"),1:0)
DO CALC^APCLOSUT
+7 WRITE X," refills (",Z,")",!,"during this period."
+8 QUIT
CHS ;
+1 IF $Y>(IOSL-10)
DO HEAD^APCLOSP
IF $DATA(APCLQUIT)
QUIT
+2 WRITE !!,"CONTRACT HEALTH SERVICES"
+3 IF '$DATA(^XTMP("APCLOS",APCLJOB,APCLBTH,"CHSTOTAL"))
WRITE !?10,"[ NO CHS DATA TO REPORT ]",!
QUIT
+4 SET X=$SELECT($DATA(^XTMP("APCLOS",APCLJOB,APCLBTH,"CHSTOTAL")):^("CHSTOTAL"),1:0)
SET Y=$SELECT($DATA(^XTMP("APCLOSP",APCLJOB,APCLBTH,"CHSTOTAL")):^("CHSTOTAL"),1:0)
DO CALC^APCLOSUT
+5 WRITE !!,"Total CHS expenditures (obligations adjusted by payments) for this period were",!,X," (",Z,"). The number and dollar amount of authorizations by type were:",!
+6 SET APCLN=0
FOR
SET APCLN=$ORDER(^XTMP("APCLOS",APCLJOB,APCLBTH,"CHS",APCLN))
IF APCLN=""
QUIT
DO CHS1
+7 QUIT
CHS1 ;
+1 SET APCLTYPE=""
FOR
SET APCLTYPE=$ORDER(^XTMP("APCLOS",APCLJOB,APCLBTH,"CHS",APCLN,APCLTYPE))
IF APCLTYPE=""
QUIT
DO CHS2
+2 QUIT
CHS2 ;
+1 SET X=$SELECT($DATA(^XTMP("APCLOS",APCLJOB,APCLBTH,"CHS",APCLN,APCLTYPE)):^(APCLTYPE),1:0)
SET Y=$SELECT($DATA(^XTMP("APCLOSP",APCLJOB,APCLBTH,"CHS",APCLN,APCLTYPE)):^(APCLTYPE),1:0)
DO CALC^APCLOSUT
+2 WRITE !?5,APCLTYPE,?40,^XTMP("APCLOS",APCLJOB,APCLBTH,"CHSCOUNT",APCLN,APCLTYPE),?50,^XTMP("APCLOS",APCLJOB,APCLBTH,"CHS",APCLN,APCLTYPE)
+3 QUIT
