- 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
