ADGSTAW.m

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)