- ADGSTAW ; IHS/ADC/PDW/ENM - INPATIENT STATISTICS BY WARD ; [ 03/25/1999 11:48 AM ]
- ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
- ;
- W @IOF,!!!?18,"INPATIENT STATISTICS BY WARD",!!
- A ; -- driver
- D BD I Y=-1 D Q Q
- D ED I Y=-1 D Q Q
- D ZIS I POP D Q Q
- I $D(IO("Q")) D QUE,Q Q
- EN ;EP; -- queued entry point
- D D,^ADGSTAW1,Q Q
- ;
- BD ; -- beginning date
- S %DT="AEQ",%DT("A")="Select beginning date: ",X="" D ^%DT S DGBD=Y Q
- ;
- ED ; -- ending date
- S %DT="AEQ",%DT("A")="Select ending date: ",X="" D ^%DT S DGED=Y
- I Y<DGBD D G BD
- . W !!,*7,"Ending date cannot be earlier than beginning date!"
- . W !,"Let's start over . . ",!
- Q
- ;
- ZIS ; -- select device
- S %ZIS="PQ" D ^%ZIS Q
- ;
- QUE K IO("Q") S ZTRTN="EN^ADGSTAW",ZTDESC="INPATIENT STATS BY WARD"
- S ZTSAVE("DGBD")="",ZTSAVE("DGED")="" D ^%ZTLOAD D ^%ZISC K ZTSK Q
- ;
- Q ; -- cleanup
- K X,Y,D,N,W,P,DGBD,DGED D HOME^%ZIS Q
- ;
- D ; -- driver
- D I,L Q
- ;
- I ; -- init
- S W=0 F S W=$O(^ADGWD(W)) Q:'W S:$$AW DGWD(W)=0
- Q
- ;
- L ; -- loop adt census-ward file (W)ard/(D)ate
- S W=0 F S W=$O(^ADGWD(W)) Q:'W D
- . Q:'$$AW S D=DGBD-.001 F S D=$O(^ADGWD(W,1,D)) Q:D>DGED Q:'D D 1
- Q
- ;
- 1 ; -- total fields
- S N=$G(^ADGWD(W,1,D,0)) Q:'N
- F P=2:1:9,12:1:19 S $P(DGWD(W),U,P)=$P(DGWD(W),U,P)+$P(N,U,P)
- Q
- ;
- AW() ; -- admitting ward
- Q $S($D(^DIC(42,"AGL",1,W)):1,1:0)
- ADGSTAW ; IHS/ADC/PDW/ENM - INPATIENT STATISTICS BY WARD ; [ 03/25/1999 11:48 AM ]
- +1 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
- +2 ;
- +3 WRITE @IOF,!!!?18,"INPATIENT STATISTICS BY WARD",!!
- A ; -- driver
- +1 DO BD
- IF Y=-1
- DO Q
- QUIT
- +2 DO ED
- IF Y=-1
- DO Q
- QUIT
- +3 DO ZIS
- IF POP
- DO Q
- QUIT
- +4 IF $DATA(IO("Q"))
- DO QUE
- DO Q
- QUIT
- EN ;EP; -- queued entry point
- +1 DO D
- DO ^ADGSTAW1
- DO Q
- QUIT
- +2 ;
- BD ; -- beginning date
- +1 SET %DT="AEQ"
- SET %DT("A")="Select beginning date: "
- SET X=""
- DO ^%DT
- SET DGBD=Y
- QUIT
- +2 ;
- ED ; -- ending date
- +1 SET %DT="AEQ"
- SET %DT("A")="Select ending date: "
- SET X=""
- DO ^%DT
- SET DGED=Y
- +2 IF Y<DGBD
- Begin DoDot:1
- +3 WRITE !!,*7,"Ending date cannot be earlier than beginning date!"
- +4 WRITE !,"Let's start over . . ",!
- End DoDot:1
- GOTO BD
- +5 QUIT
- +6 ;
- ZIS ; -- select device
- +1 SET %ZIS="PQ"
- DO ^%ZIS
- QUIT
- +2 ;
- QUE KILL IO("Q")
- SET ZTRTN="EN^ADGSTAW"
- SET ZTDESC="INPATIENT STATS BY WARD"
- +1 SET ZTSAVE("DGBD")=""
- SET ZTSAVE("DGED")=""
- DO ^%ZTLOAD
- DO ^%ZISC
- KILL ZTSK
- QUIT
- +2 ;
- Q ; -- cleanup
- +1 KILL X,Y,D,N,W,P,DGBD,DGED
- DO HOME^%ZIS
- QUIT
- +2 ;
- D ; -- driver
- +1 DO I
- DO L
- QUIT
- +2 ;
- I ; -- init
- +1 SET W=0
- FOR
- SET W=$ORDER(^ADGWD(W))
- IF 'W
- QUIT
- IF $$AW
- SET DGWD(W)=0
- +2 QUIT
- +3 ;
- L ; -- loop adt census-ward file (W)ard/(D)ate
- +1 SET W=0
- FOR
- SET W=$ORDER(^ADGWD(W))
- IF 'W
- QUIT
- Begin DoDot:1
- +2 IF '$$AW
- QUIT
- SET D=DGBD-.001
- FOR
- SET D=$ORDER(^ADGWD(W,1,D))
- IF D>DGED
- QUIT
- IF 'D
- QUIT
- DO 1
- End DoDot:1
- +3 QUIT
- +4 ;
- 1 ; -- total fields
- +1 SET N=$GET(^ADGWD(W,1,D,0))
- IF 'N
- QUIT
- +2 FOR P=2:1:9,12:1:19
- SET $PIECE(DGWD(W),U,P)=$PIECE(DGWD(W),U,P)+$PIECE(N,U,P)
- +3 QUIT
- +4 ;
- AW() ; -- admitting ward
- +1 QUIT $SELECT($DATA(^DIC(42,"AGL",1,W)):1,1:0)
