ADGAD4.m

ADGAD4 ; IHS/ADC/PDW/ENM - A&D UPDATE ADT CENSUS-WARD ; [ 03/25/1999  11:48 AM ]

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

 ;

 ; Variables PD, RD used by VA G&L routines.

 ;

 N TS,WD

 L +^ADGWD:1 I '$T Q

 L +^ADGTX:1 I '$T Q

A ; -- main

 D LW Q

 ;

LW ; -- loop wards w/activity

 S WD=0 F  S WD=$O(DGWD(WD)) Q:'WD  D

 . S:'$D(^ADGWD(WD,0)) ^(0)=WD,^(1,0)="^9009011.01D"

 . I '$D(^ADGWD(WD,1,RD)) D

 .. S $P(^ADGWD(WD,1,0),U,3,4)=RD_U_($P($G(^(0)),U,4)+1)

 . S ^ADGWD(WD,1,RD,0)=RD_U_$$PR_U_DGWD(WD)

 . S $P(^ADGWD(WD,1,RD,0),U,12)=$$NPR,^(0)=^(0)_U_DGWD("NB",WD)

 . S ^ADGWD("AB",RD,WD,RD)=""

 Q

 ;

PRP() ; -- patients remaining, previous

 Q $P($G(^ADGWD(WD,1,PD,0)),U,2)

 ;

NPRP() ; -- newborn patients remaining, previous

 Q $P($G(^ADGWD(WD,1,PD,0)),U,12)

 ;

PR() ; -- patients remaining

 Q $$PRP+$P(DGWD(WD),U)-$P(DGWD(WD),U,2)+$P(DGWD(WD),U,3)-$P(DGWD(WD),U,4)-$P(DGWD(WD),U,5)

 ;

NPR() ; -- newborn patients remaining

 Q $$NPRP+$P(DGWD("NB",WD),U)-$P(DGWD("NB",WD),U,2)+$P(DGWD("NB",WD),U,3)-$P(DGWD("NB",WD),U,4)-$P(DGWD("NB",WD),U,5)

ADGAD4    ; IHS/ADC/PDW/ENM - A&D UPDATE ADT CENSUS-WARD ; [ 03/25/1999  11:48 AM ]

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

 +2       ;

 +3       ; Variables PD, RD used by VA G&L routines.

 +4       ;

 +5        NEW TS,WD

 +6        LOCK +^ADGWD:1

           IF '$TEST

               QUIT 

 +7        LOCK +^ADGTX:1

           IF '$TEST

               QUIT 

A         ; -- main

 +1        DO LW

           QUIT 

 +2       ;

LW        ; -- loop wards w/activity

 +1        SET WD=0

           FOR 

               SET WD=$ORDER(DGWD(WD))

               IF 'WD

                   QUIT 

               Begin DoDot:1

 +2                IF '$DATA(^ADGWD(WD,0))

                       SET ^(0)=WD

                       SET ^(1,0)="^9009011.01D"

 +3                IF '$DATA(^ADGWD(WD,1,RD))

                       Begin DoDot:2

 +4                        SET $PIECE(^ADGWD(WD,1,0),U,3,4)=RD_U_($PIECE($GET(^(0)),U,4)+1)

                       End DoDot:2

 +5                SET ^ADGWD(WD,1,RD,0)=RD_U_$$PR_U_DGWD(WD)

 +6                SET $PIECE(^ADGWD(WD,1,RD,0),U,12)=$$NPR

                   SET ^(0)=^(0)_U_DGWD("NB",WD)

 +7                SET ^ADGWD("AB",RD,WD,RD)=""

               End DoDot:1

 +8        QUIT 

 +9       ;

PRP()     ; -- patients remaining, previous

 +1        QUIT $PIECE($GET(^ADGWD(WD,1,PD,0)),U,2)

 +2       ;

NPRP()    ; -- newborn patients remaining, previous

 +1        QUIT $PIECE($GET(^ADGWD(WD,1,PD,0)),U,12)

 +2       ;

PR()      ; -- patients remaining

 +1        QUIT $$PRP+$P(DGWD(WD),U)-$PIECE(DGWD(WD),U,2)+$PIECE(DGWD(WD),U,3)-$PIECE(DGWD(WD),U,4)-$PIECE(DGWD(WD),U,5)

 +2       ;

NPR()     ; -- newborn patients remaining

 +1        QUIT $$NPRP+$P(DGWD("NB",WD),U)-$PIECE(DGWD("NB",WD),U,2)+$PIECE(DGWD("NB",WD),U,3)-$PIECE(DGWD("NB",WD),U,4)-$PIECE(DGWD("NB",WD),U,5)