- 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
