ADGADSP3 ; IHS/ADC/PDW/ENM - A & D SHEET PRINT (SUMMARY) ; [ 03/25/1999 11:48 AM ]
;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
;
;***> Summary version of ADMISSIONS & DISCHARGES SHEET
;
;***> initialize variables
S X1=DGDATE,X2=-1 D C^%DTC S DGOLD=X ;get prev date
S DGZ=0 F I=1:1:7 S DGCT(I)=0 ;initialize counts
S DGPAGE=0,DGSTOP="" D HEAD
S DGLIN="",$P(DGLIN,"-",37)=""
;
;***> loop thru adt census-treating specialty file for census figures
A1 S DGZ=$O(^ADGTX(DGZ)) G A3:DGZ'?1N.N G:'$$AS A1
W !,$P(^DIC(45.7,DGZ,0),U) ;print service name
I '$D(^ADGTX(DGZ,1,DGOLD,0))!'$D(^(1)) G A1 ;skip if no data for prev
S DGX=$P(^ADGTX(DGZ,1,DGOLD,0),U,2)+$P(^(1),U)
S DGCT(1)=DGCT(1)+DGX W ?20,DGX ;old count
I '$D(^ADGTX(DGZ,1,DGDATE,0))!'$D(^(1)) G A1 ;skip if no data for date
S DGSTR=^ADGTX(DGZ,1,DGDATE,0),DGPSTR=^(1) ;set adult & peds var
S DGX=($P(DGSTR,U,3)+$P(DGPSTR,U,2)),DGCT(2)=DGCT(2)+DGX W ?30,DGX
S DGX=($P(DGSTR,U,5)+$P(DGPSTR,U,4)),DGCT(3)=DGCT(3)+DGX W ?38,DGX
S DGX=($P(DGSTR,U,7)+$P(DGPSTR,U,6)),DGCT(4)=DGCT(4)+DGX W ?47,DGX
S DGX=($P(DGSTR,U,4)+$P(DGPSTR,U,3)),DGCT(5)=DGCT(5)+DGX W ?54,DGX
S DGX=($P(DGSTR,U,6)+$P(DGPSTR,U,5)),DGCT(6)=DGCT(6)+DGX W ?61,DGX
S DGX=($P(DGSTR,U,2)+$P(DGPSTR,U)),DGCT(7)=DGCT(7)+DGX W ?71,DGX
I $Y>(IOSL-5) D NEWPG G END1:DGSTOP=U
G A1
;
;***> print census totals
A3 W !?17,"----------------------------------------------------------"
W !?5,"TOTALS:",?18,$J(DGCT(1),3),?28,$J(DGCT(2),3),?36,$J(DGCT(3),3)
W ?45,$J(DGCT(4),3),?51,$J(DGCT(5),3),?59,$J(DGCT(6),3)
W ?69,$J(DGCT(7),3)
;
NEXT G ^ADGADSP4 ;prints individual patient data
;
END I IOST["C-" K DIR S DIR("A")="Press RETURN to continue",DIR(0)="E" D ^DIR
END1 ;EP;***> ending point for summary A&D Sheets
W @IOF D KILL^ADGUTIL
D ^%ZISC K ^TMP("DGZADS",$J)
Q
;
;
NEWPG ;EP;***> end of page control
I IOST["C-" K DIR S DIR(0)="E" D ^DIR S DGSTOP=X Q:X=U
W @IOF
W !?11,"*****Confidential Patient Data Covered by Privacy Act*****",!
Q
;
HEAD ;***> print heading
S DGY=^AUTTLOC(DUZ(2),0),DGFAC=$P(^DIC(4,DUZ(2),0),U)
I (IOST["C-")!(DGPAGE>0) W @IOF
W ?11,"*****Confidential Patient Data Covered by Privacy Act*****"
W !?(80-$L(DGFAC)/2),DGFAC ;facility name
S DGCITY=$P(DGY,U,13),DGSTAT=$P(DGY,U,14),DGSTAT=$P(^DIC(5,DGSTAT,0),U)
W !?(80-$L(DGCITY_DGSTAT)/2),DGCITY_","_DGSTAT ;city and state
W !!!,"DAILY CENSUS REPORT"
S X=DGDATE D DW^%DTC W !,X ;print day of the week
W ?10,$E(DGDATE,4,5)_"-"_$E(DGDATE,6,7)_"-"_$E(DGDATE,2,3),! ;date
S DGLIN="",$P(DGLIN,"-",80)="" W DGLIN
W !!!,"SERVICE",?17,"REMAINING",?28,"ADMITS",?35,"TRANSFERS"
W ?45,"DEATHS",?52,"OTHER",?58,"TRANSFERS",?68,"REMAINING"
W !,"Responsible",?17,"from the",?38,"IN",?53,"DIS-",?61,"OUT",?72,"At"
W !,"for Patient",?17,"Preceding",?51,"CHARGES",?69,"11:59 pm"
W !?20,"Day",!!
W DGLIN,!! Q
;
AS() ;--admitting service (yes=1,no=0)
Q $S($P($G(^DIC(45.7,+DGZ,9999999)),U,3)="Y":1,1:0)
ADGADSP3 ; IHS/ADC/PDW/ENM - A & D SHEET PRINT (SUMMARY) ; [ 03/25/1999 11:48 AM ]
+1 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
+2 ;
+3 ;***> Summary version of ADMISSIONS & DISCHARGES SHEET
+4 ;
+5 ;***> initialize variables
+6 ;get prev date
SET X1=DGDATE
SET X2=-1
DO C^%DTC
SET DGOLD=X
+7 ;initialize counts
SET DGZ=0
FOR I=1:1:7
SET DGCT(I)=0
+8 SET DGPAGE=0
SET DGSTOP=""
DO HEAD
+9 SET DGLIN=""
SET $PIECE(DGLIN,"-",37)=""
+10 ;
+11 ;***> loop thru adt census-treating specialty file for census figures
A1 SET DGZ=$ORDER(^ADGTX(DGZ))
IF DGZ'?1N.N
GOTO A3
IF '$$AS
GOTO A1
+1 ;print service name
WRITE !,$PIECE(^DIC(45.7,DGZ,0),U)
+2 ;skip if no data for prev
IF '$DATA(^ADGTX(DGZ,1,DGOLD,0))!'$DATA(^(1))
GOTO A1
+3 SET DGX=$PIECE(^ADGTX(DGZ,1,DGOLD,0),U,2)+$PIECE(^(1),U)
+4 ;old count
SET DGCT(1)=DGCT(1)+DGX
WRITE ?20,DGX
+5 ;skip if no data for date
IF '$DATA(^ADGTX(DGZ,1,DGDATE,0))!'$DATA(^(1))
GOTO A1
+6 ;set adult & peds var
SET DGSTR=^ADGTX(DGZ,1,DGDATE,0)
SET DGPSTR=^(1)
+7 SET DGX=($PIECE(DGSTR,U,3)+$PIECE(DGPSTR,U,2))
SET DGCT(2)=DGCT(2)+DGX
WRITE ?30,DGX
+8 SET DGX=($PIECE(DGSTR,U,5)+$PIECE(DGPSTR,U,4))
SET DGCT(3)=DGCT(3)+DGX
WRITE ?38,DGX
+9 SET DGX=($PIECE(DGSTR,U,7)+$PIECE(DGPSTR,U,6))
SET DGCT(4)=DGCT(4)+DGX
WRITE ?47,DGX
+10 SET DGX=($PIECE(DGSTR,U,4)+$PIECE(DGPSTR,U,3))
SET DGCT(5)=DGCT(5)+DGX
WRITE ?54,DGX
+11 SET DGX=($PIECE(DGSTR,U,6)+$PIECE(DGPSTR,U,5))
SET DGCT(6)=DGCT(6)+DGX
WRITE ?61,DGX
+12 SET DGX=($PIECE(DGSTR,U,2)+$PIECE(DGPSTR,U))
SET DGCT(7)=DGCT(7)+DGX
WRITE ?71,DGX
+13 IF $Y>(IOSL-5)
DO NEWPG
IF DGSTOP=U
GOTO END1
+14 GOTO A1
+15 ;
+16 ;***> print census totals
A3 WRITE !?17,"----------------------------------------------------------"
+1 WRITE !?5,"TOTALS:",?18,$JUSTIFY(DGCT(1),3),?28,$JUSTIFY(DGCT(2),3),?36,$JUSTIFY(DGCT(3),3)
+2 WRITE ?45,$JUSTIFY(DGCT(4),3),?51,$JUSTIFY(DGCT(5),3),?59,$JUSTIFY(DGCT(6),3)
+3 WRITE ?69,$JUSTIFY(DGCT(7),3)
+4 ;
NEXT ;prints individual patient data
GOTO ^ADGADSP4
+1 ;
END IF IOST["C-"
KILL DIR
SET DIR("A")="Press RETURN to continue"
SET DIR(0)="E"
DO ^DIR
END1 ;EP;***> ending point for summary A&D Sheets
+1 WRITE @IOF
DO KILL^ADGUTIL
+2 DO ^%ZISC
KILL ^TMP("DGZADS",$JOB)
+3 QUIT
+4 ;
+5 ;
NEWPG ;EP;***> end of page control
+1 IF IOST["C-"
KILL DIR
SET DIR(0)="E"
DO ^DIR
SET DGSTOP=X
IF X=U
QUIT
+2 WRITE @IOF
+3 WRITE !?11,"*****Confidential Patient Data Covered by Privacy Act*****",!
+4 QUIT
+5 ;
HEAD ;***> print heading
+1 SET DGY=^AUTTLOC(DUZ(2),0)
SET DGFAC=$PIECE(^DIC(4,DUZ(2),0),U)
+2 IF (IOST["C-")!(DGPAGE>0)
WRITE @IOF
+3 WRITE ?11,"*****Confidential Patient Data Covered by Privacy Act*****"
+4 ;facility name
WRITE !?(80-$LENGTH(DGFAC)/2),DGFAC
+5 SET DGCITY=$PIECE(DGY,U,13)
SET DGSTAT=$PIECE(DGY,U,14)
SET DGSTAT=$PIECE(^DIC(5,DGSTAT,0),U)
+6 ;city and state
WRITE !?(80-$LENGTH(DGCITY_DGSTAT)/2),DGCITY_","_DGSTAT
+7 WRITE !!!,"DAILY CENSUS REPORT"
+8 ;print day of the week
SET X=DGDATE
DO DW^%DTC
WRITE !,X
+9 ;date
WRITE ?10,$EXTRACT(DGDATE,4,5)_"-"_$EXTRACT(DGDATE,6,7)_"-"_$EXTRACT(DGDATE,2,3),!
+10 SET DGLIN=""
SET $PIECE(DGLIN,"-",80)=""
WRITE DGLIN
+11 WRITE !!!,"SERVICE",?17,"REMAINING",?28,"ADMITS",?35,"TRANSFERS"
+12 WRITE ?45,"DEATHS",?52,"OTHER",?58,"TRANSFERS",?68,"REMAINING"
+13 WRITE !,"Responsible",?17,"from the",?38,"IN",?53,"DIS-",?61,"OUT",?72,"At"
+14 WRITE !,"for Patient",?17,"Preceding",?51,"CHARGES",?69,"11:59 pm"
+15 WRITE !?20,"Day",!!
+16 WRITE DGLIN,!!
QUIT
+17 ;
AS() ;--admitting service (yes=1,no=0)
+1 QUIT $SELECT($PIECE($GET(^DIC(45.7,+DGZ,9999999)),U,3)="Y":1,1:0)
