- ADGCEN0 ; IHS/ADC/PDW/ENM - CENSUS AID-LIST BY WARD ; [ 03/25/1999 11:48 AM ]
- ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
- ;
- ;***> initialize variables
- S DGPAGE=0,DGSITE=$P(^DIC(4,DUZ(2),0),U),DGDUZ=$P(^VA(200,DUZ,0),U,2)
- S DGTL=$P(^DIC(42,DGWD,0),U)_" WARD"
- D HEAD
- ;
- ;***> loop thru adt census-ward file by date
- S DGDT=DGBDT-.0001
- DT1 S DGDT=$O(^ADGWD(DGWD,1,DGDT)) G END:DGDT="",END:DGDT>DGEDT
- ;
- I '$D(^ADGWD(DGWD,1,DGDT,0)) D G END
- .W !!,"NO CENSUS DATA FOR THIS WARD FOR "
- .W $E(DGDT,4,5)_"/"_$E(DGDT,6,7)_"/"_$E(DGDT,2,3),!! Q
- ;
- S DGSTR=^ADGWD(DGWD,1,DGDT,0)
- W !,$E(DGDT,4,5)_"/"_$E(DGDT,6,7)_"/"_$E(DGDT,2,3) ;date
- ;W ?17,$P(DGSTR,U,3),?27,$P(DGSTR,U,5) ;admits & transfers in
- ;W ?37,$P(DGSTR,U,6),?48,$P(DGSTR,U,4) ;transfers out & discharges
- ;W ?58,$P(DGSTR,U,7),?69,$P(DGSTR,U,2) ;deaths and # remaining
- W ?17,$P(DGSTR,U,3)+$P(DGSTR,U,13),?27,$P(DGSTR,U,5)+$P(DGSTR,U,15)
- W ?37,$P(DGSTR,U,6)+$P(DGSTR,U,16),?48,$P(DGSTR,U,4)+$P(DGSTR,U,14)
- W ?58,$P(DGSTR,U,7)+$P(DGSTR,U,17),?69,$P(DGSTR,U,2)+$P(DGSTR,U,12)
- I $Y>(IOSL-6) D NEWPG G END1:DGSTOP=U
- G DT1
- ;
- END I IOST["C-" K DIR S DIR(0)="E" D ^DIR
- END1 W @IOF K DGBDT,DGEDT,DGDT,DGWD,DGPAGE,DGSITE,DGLIN,DGX
- K DGDUZ,DGTL,DGSTR,DGSTOP,DGTYP,X,Y,DIR D ^%ZISC Q
- ;
- NEWPG ;***> subrtn for end of page control
- I IOST'?1"C-".E D HEAD S DGSTOP="" Q
- K DIR S DIR(0)="E" D ^DIR S DGSTOP=X
- I DGSTOP'=U D HEAD
- Q
- ;
- HEAD ;***> subrtn to print heading
- I (IOST["C-")!(DGPAGE>0) W @IOF
- S DGPAGE=DGPAGE+1 W !,DGDUZ,?80-$L(DGSITE)/2,DGSITE
- W ! D TIME^ADGUTIL W ?28,"ADT WARD CENSUS DATA FOR"
- S Y=DT X ^DD("DD") W !,Y
- W ?80-$L(DGTL)/2,DGTL,?70,"Page: ",DGPAGE
- S DGLIN="",$P(DGLIN,"=",80)="" W !,DGLIN
- W !,"Date",?15,"Admits",?25,"Trans In",?35,"Trans Out"
- W ?46,"Disch",?55,"Deaths",?65,"Remaining"
- S DGLIN="",$P(DGLIN,"-",80)="" W !,DGLIN,!
- Q
- ADGCEN0 ; IHS/ADC/PDW/ENM - CENSUS AID-LIST BY WARD ; [ 03/25/1999 11:48 AM ]
- +1 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
- +2 ;
- +3 ;***> initialize variables
- +4 SET DGPAGE=0
- SET DGSITE=$PIECE(^DIC(4,DUZ(2),0),U)
- SET DGDUZ=$PIECE(^VA(200,DUZ,0),U,2)
- +5 SET DGTL=$PIECE(^DIC(42,DGWD,0),U)_" WARD"
- +6 DO HEAD
- +7 ;
- +8 ;***> loop thru adt census-ward file by date
- +9 SET DGDT=DGBDT-.0001
- DT1 SET DGDT=$ORDER(^ADGWD(DGWD,1,DGDT))
- IF DGDT=""
- GOTO END
- IF DGDT>DGEDT
- GOTO END
- +1 ;
- +2 IF '$DATA(^ADGWD(DGWD,1,DGDT,0))
- Begin DoDot:1
- +3 WRITE !!,"NO CENSUS DATA FOR THIS WARD FOR "
- +4 WRITE $EXTRACT(DGDT,4,5)_"/"_$EXTRACT(DGDT,6,7)_"/"_$EXTRACT(DGDT,2,3),!!
- QUIT
- End DoDot:1
- GOTO END
- +5 ;
- +6 SET DGSTR=^ADGWD(DGWD,1,DGDT,0)
- +7 ;date
- WRITE !,$EXTRACT(DGDT,4,5)_"/"_$EXTRACT(DGDT,6,7)_"/"_$EXTRACT(DGDT,2,3)
- +8 ;W ?17,$P(DGSTR,U,3),?27,$P(DGSTR,U,5) ;admits & transfers in
- +9 ;W ?37,$P(DGSTR,U,6),?48,$P(DGSTR,U,4) ;transfers out & discharges
- +10 ;W ?58,$P(DGSTR,U,7),?69,$P(DGSTR,U,2) ;deaths and # remaining
- +11 WRITE ?17,$PIECE(DGSTR,U,3)+$PIECE(DGSTR,U,13),?27,$PIECE(DGSTR,U,5)+$PIECE(DGSTR,U,15)
- +12 WRITE ?37,$PIECE(DGSTR,U,6)+$PIECE(DGSTR,U,16),?48,$PIECE(DGSTR,U,4)+$PIECE(DGSTR,U,14)
- +13 WRITE ?58,$PIECE(DGSTR,U,7)+$PIECE(DGSTR,U,17),?69,$PIECE(DGSTR,U,2)+$PIECE(DGSTR,U,12)
- +14 IF $Y>(IOSL-6)
- DO NEWPG
- IF DGSTOP=U
- GOTO END1
- +15 GOTO DT1
- +16 ;
- END IF IOST["C-"
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- END1 WRITE @IOF
- KILL DGBDT,DGEDT,DGDT,DGWD,DGPAGE,DGSITE,DGLIN,DGX
- +1 KILL DGDUZ,DGTL,DGSTR,DGSTOP,DGTYP,X,Y,DIR
- DO ^%ZISC
- QUIT
- +2 ;
- NEWPG ;***> subrtn for end of page control
- +1 IF IOST'?1"C-".E
- DO HEAD
- SET DGSTOP=""
- QUIT
- +2 KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- SET DGSTOP=X
- +3 IF DGSTOP'=U
- DO HEAD
- +4 QUIT
- +5 ;
- HEAD ;***> subrtn to print heading
- +1 IF (IOST["C-")!(DGPAGE>0)
- WRITE @IOF
- +2 SET DGPAGE=DGPAGE+1
- WRITE !,DGDUZ,?80-$LENGTH(DGSITE)/2,DGSITE
- +3 WRITE !
- DO TIME^ADGUTIL
- WRITE ?28,"ADT WARD CENSUS DATA FOR"
- +4 SET Y=DT
- XECUTE ^DD("DD")
- WRITE !,Y
- +5 WRITE ?80-$LENGTH(DGTL)/2,DGTL,?70,"Page: ",DGPAGE
- +6 SET DGLIN=""
- SET $PIECE(DGLIN,"=",80)=""
- WRITE !,DGLIN
- +7 WRITE !,"Date",?15,"Admits",?25,"Trans In",?35,"Trans Out"
- +8 WRITE ?46,"Disch",?55,"Deaths",?65,"Remaining"
- +9 SET DGLIN=""
- SET $PIECE(DGLIN,"-",80)=""
- WRITE !,DGLIN,!
- +10 QUIT
