ADGSTAT ; IHS/ADC/PDW/ENM - INPATIENT STATISTICS BY SERVICE ; [ 03/25/1999 11:48 AM ]
;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
;
W @IOF,!!!?18,"INPATIENT STATISTICS BY SERVICE",!!
;
;***> get date range
BDATE S %DT="AEQ",%DT("A")="Select beginning date: ",X="" D ^%DT
G END:Y=-1 S DGBDT=Y
EDATE S %DT="AEQ",%DT("A")="Select ending date: ",X="" D ^%DT
G END:Y=-1
I Y<DGBDT D G BDATE
. W !!,*7,"Ending date cannot be earlier than beginning date!"
. W !,"Let's start over . . ",!
S DGEDT=Y
;
;***> get print device
S %ZIS="PQ" D ^%ZIS G END:POP,QUE:$D(IO("Q")) U IO G CALC
QUE K IO("Q") S ZTRTN="CALC^ADGSTAT",ZTDESC="INPATIENT STATS"
S ZTSAVE("DGBDT")="",ZTSAVE("DGEDT")=""
D ^%ZTLOAD D ^%ZISC K ZTSK Q
END K Y,DGBDT,DGEDT D HOME^%ZIS Q
;
;
CALC ;***> Beginning of calculate of ADPL & inpatient data
S DGZ=0 F S DGZ=$O(^ADGTX(DGZ)) Q:DGZ'?1N.N S (DGA(DGZ),DGP(DGZ))=0
S DGZ=0
C1 S DGZ=$O(^ADGTX(DGZ)) G NEXT:DGZ'?1N.N S DGD=DGBDT-.001
C2 S DGD=$O(^ADGTX(DGZ,1,DGD)) G C1:DGD>DGEDT,C1:DGD=""
S DGSTR=$G(^ADGTX(DGZ,1,DGD,0)) S DGSTR1=$G(^ADGTX(DGZ,1,DGD,1))
S $P(DGA(DGZ),U)=$P(DGA(DGZ),U)+$P(DGSTR,U,3)
S $P(DGA(DGZ),U,2)=$P(DGA(DGZ),U,2)+$P(DGSTR,U,4)
S $P(DGA(DGZ),U,3)=$P(DGA(DGZ),U,3)+$P(DGSTR,U,7)
S $P(DGA(DGZ),U,4)=$P(DGA(DGZ),U,4)+$P(DGSTR,U,2)+$P(DGSTR,U,8)
S $P(DGA(DGZ),U,5)=$P(DGA(DGZ),U,5)+$P(DGSTR,U,9)
S $P(DGA(DGZ),U,6)=$P(DGA(DGZ),U,6)+$P(DGSTR,U,6)
S $P(DGA(DGZ),U,7)=$P(DGA(DGZ),U,7)+$P(DGSTR,U,5)
S $P(DGP(DGZ),U)=$P(DGP(DGZ),U)+$P(DGSTR1,U,2)
S $P(DGP(DGZ),U,2)=$P(DGP(DGZ),U,2)+$P(DGSTR1,U,3)
S $P(DGP(DGZ),U,3)=$P(DGP(DGZ),U,3)+$P(DGSTR1,U,6)
S $P(DGP(DGZ),U,4)=$P(DGP(DGZ),U,4)+$P(DGSTR1,U)+$P(DGSTR1,U,7)
S $P(DGP(DGZ),U,5)=$P(DGP(DGZ),U,5)+$P(DGSTR1,U,8)
S $P(DGP(DGZ),U,6)=$P(DGP(DGZ),U,6)+$P(DGSTR1,U,5)
S $P(DGP(DGZ),U,7)=$P(DGP(DGZ),U,7)+$P(DGSTR1,U,4) G C2
;
NEXT G ^ADGSTAT1
ADGSTAT ; IHS/ADC/PDW/ENM - INPATIENT STATISTICS BY SERVICE ; [ 03/25/1999 11:48 AM ]
+1 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
+2 ;
+3 WRITE @IOF,!!!?18,"INPATIENT STATISTICS BY SERVICE",!!
+4 ;
+5 ;***> get date range
BDATE SET %DT="AEQ"
SET %DT("A")="Select beginning date: "
SET X=""
DO ^%DT
+1 IF Y=-1
GOTO END
SET DGBDT=Y
EDATE SET %DT="AEQ"
SET %DT("A")="Select ending date: "
SET X=""
DO ^%DT
+1 IF Y=-1
GOTO END
+2 IF Y<DGBDT
Begin DoDot:1
+3 WRITE !!,*7,"Ending date cannot be earlier than beginning date!"
+4 WRITE !,"Let's start over . . ",!
End DoDot:1
GOTO BDATE
+5 SET DGEDT=Y
+6 ;
+7 ;***> get print device
+8 SET %ZIS="PQ"
DO ^%ZIS
IF POP
GOTO END
IF $DATA(IO("Q"))
GOTO QUE
USE IO
GOTO CALC
QUE KILL IO("Q")
SET ZTRTN="CALC^ADGSTAT"
SET ZTDESC="INPATIENT STATS"
+1 SET ZTSAVE("DGBDT")=""
SET ZTSAVE("DGEDT")=""
+2 DO ^%ZTLOAD
DO ^%ZISC
KILL ZTSK
QUIT
END KILL Y,DGBDT,DGEDT
DO HOME^%ZIS
QUIT
+1 ;
+2 ;
CALC ;***> Beginning of calculate of ADPL & inpatient data
+1 SET DGZ=0
FOR
SET DGZ=$ORDER(^ADGTX(DGZ))
IF DGZ'?1N.N
QUIT
SET (DGA(DGZ),DGP(DGZ))=0
+2 SET DGZ=0
C1 SET DGZ=$ORDER(^ADGTX(DGZ))
IF DGZ'?1N.N
GOTO NEXT
SET DGD=DGBDT-.001
C2 SET DGD=$ORDER(^ADGTX(DGZ,1,DGD))
IF DGD>DGEDT
GOTO C1
IF DGD=""
GOTO C1
+1 SET DGSTR=$GET(^ADGTX(DGZ,1,DGD,0))
SET DGSTR1=$GET(^ADGTX(DGZ,1,DGD,1))
+2 SET $PIECE(DGA(DGZ),U)=$PIECE(DGA(DGZ),U)+$PIECE(DGSTR,U,3)
+3 SET $PIECE(DGA(DGZ),U,2)=$PIECE(DGA(DGZ),U,2)+$PIECE(DGSTR,U,4)
+4 SET $PIECE(DGA(DGZ),U,3)=$PIECE(DGA(DGZ),U,3)+$PIECE(DGSTR,U,7)
+5 SET $PIECE(DGA(DGZ),U,4)=$PIECE(DGA(DGZ),U,4)+$PIECE(DGSTR,U,2)+$PIECE(DGSTR,U,8)
+6 SET $PIECE(DGA(DGZ),U,5)=$PIECE(DGA(DGZ),U,5)+$PIECE(DGSTR,U,9)
+7 SET $PIECE(DGA(DGZ),U,6)=$PIECE(DGA(DGZ),U,6)+$PIECE(DGSTR,U,6)
+8 SET $PIECE(DGA(DGZ),U,7)=$PIECE(DGA(DGZ),U,7)+$PIECE(DGSTR,U,5)
+9 SET $PIECE(DGP(DGZ),U)=$PIECE(DGP(DGZ),U)+$PIECE(DGSTR1,U,2)
+10 SET $PIECE(DGP(DGZ),U,2)=$PIECE(DGP(DGZ),U,2)+$PIECE(DGSTR1,U,3)
+11 SET $PIECE(DGP(DGZ),U,3)=$PIECE(DGP(DGZ),U,3)+$PIECE(DGSTR1,U,6)
+12 SET $PIECE(DGP(DGZ),U,4)=$PIECE(DGP(DGZ),U,4)+$PIECE(DGSTR1,U)+$PIECE(DGSTR1,U,7)
+13 SET $PIECE(DGP(DGZ),U,5)=$PIECE(DGP(DGZ),U,5)+$PIECE(DGSTR1,U,8)
+14 SET $PIECE(DGP(DGZ),U,6)=$PIECE(DGP(DGZ),U,6)+$PIECE(DGSTR1,U,5)
+15 SET $PIECE(DGP(DGZ),U,7)=$PIECE(DGP(DGZ),U,7)+$PIECE(DGSTR1,U,4)
GOTO C2
+16 ;
NEXT GOTO ^ADGSTAT1
