ADGIPCU.m

ADGIPCU ; IHS/ADC/PDW/ENM - ICU/PCU PTS REM COUNT ; [ 03/25/1999  11:48 AM ]

 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999

 ;

 N PCU,ICU,DATE

 S (PCU,ICU)=0,DATE=2921231.9

 F  S DATE=$O(^ADGWD(5,1,DATE)) Q:DATE>2931231  D

 . I $P(^ADGWD(5,1,DATE,0),U,2)>6 S PCU=PCU+1

 . I $P(^ADGWD(6,1,DATE,0),U,2)>4 S ICU=ICU+1

 W !!,"PCU=",PCU,!,"ICU=",ICU

ADGIPCU   ; IHS/ADC/PDW/ENM - ICU/PCU PTS REM COUNT ; [ 03/25/1999  11:48 AM ]

 +1       ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999

 +2       ;

 +3        NEW PCU,ICU,DATE

 +4        SET (PCU,ICU)=0

           SET DATE=2921231.9

 +5        FOR 

               SET DATE=$ORDER(^ADGWD(5,1,DATE))

               IF DATE>2931231

                   QUIT 

               Begin DoDot:1

 +6                IF $PIECE(^ADGWD(5,1,DATE,0),U,2)>6

                       SET PCU=PCU+1

 +7                IF $PIECE(^ADGWD(6,1,DATE,0),U,2)>4

                       SET ICU=ICU+1

               End DoDot:1

 +8        WRITE !!,"PCU=",PCU,!,"ICU=",ICU