Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ADGSTAT1

ADGSTAT1.m

Go to the documentation of this file. 
  1. ADGSTAT1 ; IHS/ADC/PDW/ENM - INPAT STATS BY SERV (cont) ; [ 03/25/1999  11:48 AM ]
  1.  ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
  1.  ;
  1.  S DGFAC=$P(^DIC(4,DUZ(2),0),U),DGDUZ=$P(^VA(200,DUZ,0),U,2)
  1.  S DGSTOP=""
  1. A ; -- main
  1.  D HD,AD,AT,PG I DGSTOP=U D Q Q
  1.  D PD,PT,PG I DGSTOP=U D Q Q
  1.  D GT,NB,TR,PRTOPT^ADGVAR,Q Q
  1.  ;
  1.  W !?3,"ADULT PATIENTS"
  1.  S (DGADT,DGDST,DGTIT,DGTOT,DGDTT,DGINT,DGAVT,DGALT,DGDVT)=0
  1.  N TS S TS=0 F  S TS=$O(DGA(TS)) Q:'TS  D
  1.  . Q:'$$AS  D A1
  1.  Q
  1.  ;
  1. A1 Q:$P(^DIC(45.7,TS,0),U)="NEWBORN"
  1.  ; -- adic (average daily inpatient census)
  1.  S DGAV=$$DF($P(DGA(TS),U,4)/$$ND(DGEDT,DGBDT))
  1.  ; -- alos
  1.  S DGAL=$$DF($P(DGA(TS),U,5)/$S($$LA:$$LA,1:1))
  1.  ; -- totals
  1.  ; -- adm dis tx_in tx_out dth rem+1day adic losses los
  1.  S DGADT=DGADT+$P(DGA(TS),U),DGDST=DGDST+$P(DGA(TS),U,2)
  1.  S DGTIT=DGTIT+$P(DGA(TS),U,7),DGTOT=DGTOT+$P(DGA(TS),U,6)
  1.  S DGDTT=DGDTT+$P(DGA(TS),U,3),DGINT=DGINT+$P(DGA(TS),U,4)
  1.  S DGAVT=DGAVT+DGAV,DGDVT=DGDVT+$$LA,DGALT=DGALT+$P(DGA(TS),U,5)
  1.  ; -- line
  1.  I $Y>(IOSL-6) D PG
  1.  W !,$E($P(^DIC(45.7,TS,0),U),1,15),?19,$J(+$P(DGA(TS),U),3)
  1.  W ?25,$J(+$P(DGA(TS),U,7),3),?31,$J(+$P(DGA(TS),U,6),3)
  1.  W ?37,$J(+$P(DGA(TS),U,2),3),?43,$J(+$P(DGA(TS),U,3),3)
  1.  W ?49,$J(+$P(DGA(TS),U,4),4),?56,$J(DGAV,5)
  1.  W ?64,$J(+$P(DGA(TS),U,5),4),?71,$J(DGAL,5) Q
  1.  ;
  1. AT ; -- adult totals
  1.  W !,$$LN("-"),!!?8,"TOTAL:",?19,$J(DGADT,3)
  1.  W ?25,$J(DGTIT,3),?31,$J(DGTOT,3),?37,$J(DGDST,3)
  1.  W ?43,$J(DGDTT,3),?49,$J(DGINT,4),?56,$J($$DF(DGAVT),5)
  1.  W ?64,$J(DGALT,4),?71,$J($$DF(DGALT/$S(DGDVT:DGDVT,1:1)),5) Q
  1.  ;
  1. PD W !!?3,"PEDIATRIC PATIENTS"
  1.  S (DGADP,DGDSP,DGTIP,DGTOP,DGDTP,DGINP,DGALP,DGAVP,DGDVP)=0
  1.  N TS S TS=0 F  S TS=$O(DGP(TS)) Q:'TS  D
  1.  . Q:'$$AS  D P1
  1.  Q
  1.  ;
  1. P1 I $P(^DIC(45.7,TS,0),U)="NEWBORN" S N=DGP(TS) Q
  1.  ; -- adic (average daily inpatient census)
  1.  S DGAV=$$DF($P(DGP(TS),U,4)/$$ND(DGEDT,DGBDT))
  1.  ; -- alos
  1.  S DGAL=$$DF($P(DGP(TS),U,5)/$S($$LP:$$LP,1:1))
  1.  ; -- totals
  1.  ; -- adm dis dth rem+1day adpl losses los
  1.  S DGADP=DGADP+$P(DGP(TS),U),DGDSP=DGDSP+$P(DGP(TS),U,2)
  1.  S DGTIP=DGTIP+$P(DGP(TS),U,7),DGTOP=DGTOP+$P(DGP(TS),U,6)
  1.  S DGDTP=DGDTP+$P(DGP(TS),U,3),DGINP=DGINP+$P(DGP(TS),U,4)
  1.  S DGAVP=DGAVP+DGAV,DGDVP=DGDVP+$$LP,DGALP=DGALP+$P(DGP(TS),U,5)
  1.  ; -- line
  1.  I $Y>(IOSL-6) D PG
  1.  W !,$E($P(^DIC(45.7,TS,0),U),1,15),?19,$J(+$P(DGP(TS),U),3)
  1.  W ?25,$J(+$P(DGP(TS),U,7),3),?31,$J(+$P(DGP(TS),U,6),3)
  1.  W ?37,$J(+$P(DGP(TS),U,2),3),?43,$J(+$P(DGP(TS),U,3),3)
  1.  W ?49,$J(+$P(DGP(TS),U,4),4),?56,$J(DGAV,5)
  1.  W ?64,$J(+$P(DGP(TS),U,5),4),?71,$J(DGAL,5) Q
  1.  ;
  1. PT ; -- ped total
  1.  W !,$$LN("-"),!!?8,"TOTAL:",?19,$J(DGADP,3),?25,$J(DGTIP,3)
  1.  W ?31,$J(DGTOP,3),?37,$J(DGDSP,3),?43,$J(DGDTP,3)
  1.  W ?49,$J(DGINP,4),?56,$J($$DF(DGAVP),5)
  1.  W ?64,$J(DGALP,4),?71,$J($$DF(DGALP/$S(DGDVP:DGDVP,1:1)),5) Q
  1.  ;
  1. GT ; -- grand total      
  1.  I $Y>(IOSL-6) D PG
  1.  W !!?2,"GRAND TOTAL:",?19,$J(DGADT+DGADP,3),?25,$J(DGTIT+DGTIP,3)
  1.  W ?31,$J(DGTOT+DGTOP,3),?37,$J(DGDST+DGDSP,3),?43,$J(DGDTT+DGDTP,3)
  1.  W ?49,$J(DGINT+DGINP,4),?56,$J($$DF(DGAVT+DGAVP),5)
  1.  W ?63,$J(DGALT+DGALP,5)
  1.  W ?71,$J($$DF((DGALT+DGALP)/$S(DGDVT+DGDVP:DGDVT+DGDVP,1:1)),5) Q
  1.  ;
  1. NB ; -- newborn
  1.  Q:'$D(N)  W !,$$LN("-"),!!?3,"NEWBORN",?19,$J($P(N,U),3)
  1.  W ?25,$J($P(N,U,7),3),?31,$J($P(N,U,6),3)
  1.  W ?37,$J($P(N,U,2),5),?43,$J($P(N,U,3),3)
  1.  W ?49,$J($P(N,U,4),4),?56,$J($$DF($P(N,U,4)/$$ND(DGEDT,DGBDT)),5)
  1.  W ?64,$J($P(N,U,5),4),?71,$J($$DF($P(N,U,5)/$S($$NL:$$NL,1:1)),5) Q
  1.  ;
  1. TR ; -- terms
  1.  W !!!!,"TXI = transfers in, TXO = transfers out"
  1.  W !,"DAYS = total inpatient service days"
  1.  W !,"ADPL = average daily inpatient census"
  1.  W !,"TLOS = total length of stay (discharge days)"
  1.  W !,"ALOS = average length of stay (average stay)",!! Q
  1.  ;
  1. Q ; -- cleanup
  1.  K DGADT,DGDST,DGTIT,DGTOT,DGDTT,DGINT,DGAVT,DGALT,DGDVT,DGDUZ,N
  1.  K DGADP,DGDSP,DGTIP,DGTOP,DGDTP,DGINP,DGALP,DGAVP,DGDVP,DGFAC
  1.  K DGBDT,DGEDT,DGA,DGP,DGAL,DGAV,DGD,DGZ,X,Y W @IOF D ^%ZISC Q
  1.  ;
  1.  ;
  1. HD ; -- heading
  1.  W:(IOST["C-") @IOF W DGDUZ,?80-$L(DGFAC)\2,DGFAC
  1.  W ! D TIME^ADGUTIL W ?24,"INPATIENT STATISTICS BY SERVICE"
  1.  W !,$$DT(DT),?25,"from ",$$DT(DGBDT)," to ",$$DT(DGEDT)
  1.  W !!?5,"SERVICE",?19,"ADM",?25,"TXI",?31,"TXO",?37,"DIS",?43,"DTH"
  1.  W ?49,"DAYS",?57,"ADPL",?64,"TLOS",?72,"ALOS",!,$$LN("="),! Q
  1.  ;
  1. PG ; -- page
  1.  Q:IOST'["C-"
  1.  W ! N X,Y K DIR S DIR(0)="E" D ^DIR S DGSTOP=X
  1.  I DGSTOP'=U W @IOF D HD
  1.  Q
  1.  ;
  1. AS() ; -- admitting service
  1.  Q $S($P($G(^DIC(45.7,+TS,9999999)),U,3)="Y":1,1:0)
  1.  ;
  1. LA() ; -- losses, adu (dischages + tranfer outs + deaths)
  1.  Q $P(DGA(TS),U,2)+$P(DGA(TS),U,3)+$P(DGA(TS),U,6)
  1.  ;
  1. LP() ; -- losses, ped (dischages + tranfer outs + deaths)
  1.  Q $P(DGP(TS),U,2)+$P(DGP(TS),U,3)+$P(DGP(TS),U,6)
  1.  ;
  1. NL() ; -- newborn losses (dischages + tranfer outs + deaths)
  1.  Q $P(N,U,2)+$P(N,U,3)+$P(N,U,6)
  1.  ;
  1. DF(X) ; -- decimal format
  1.  Q $P(X,".")_"."_$E(($P(X,".",2)_"00"),1,2)
  1.  ;
  1. DT(X) ; -- date format
  1.  Q $E(X,4,5)_"/"_$E(X,6,7)_"/"_($E(X,1,3)+1700)
  1.  ;
  1. LN(X,Y) ; -- line
  1.  S Y="",$P(Y,X,IOM)="" Q Y
  1.  ;
  1. ND(X1,X2,X) ; -- number of days
  1.  D ^%DTC Q X+1