- ADGCEN32 ; IHS/ADC/PDW/ENM - CENSUS WARD LISTING PRINT ; [ 03/25/1999 11:48 AM ]
- ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
- ;
- ;***> print summary page
- SUM I DGWD'="A" G END ;no summary for one ward reports
- S DGWN=0,DGW="SUMMARY" D HEAD W !!
- S1 S DGWN=$O(^DIC(42,"B",DGWN)) G S3:DGWN="" S DGWDFN=0 ;get wards' names
- S2 S DGWDFN=$O(^DIC(42,"B",DGWN,DGWDFN)) G S1:DGWDFN=""
- I $D(^DIC(42,DGWDFN,"I")),(^("I")="I") G S2 ;screen out inactive wards
- ;
- W !!?3,DGWN,?16,"______ +",?30,+$P(DGCN(DGWN),U)
- W ?42,($P(DGCN(DGWN),U,2)-$P(DGCN(DGWN),U,3))
- W ?49,"-",?55,$P(DGCN(DGWN),U,4),?65,"______" G S2
- ;
- S3 S (DGX,DGTADM)=0
- F S DGX=$O(DGCN(DGX)) Q:DGX="" S DGTADM=DGTADM+$P(DGCN(DGX),U)
- S (DGX,DGTDSC)=0
- F S DGX=$O(DGCN(DGX)) Q:DGX="" S DGTDSC=DGTDSC+$P(DGCN(DGX),U,4)
- S (DGX,DGTTR)=0
- F S DGX=$O(DGCN(DGX)) Q:DGX="" S DGTTR=DGTTR+$P(DGCN(DGX),U,2)-$P(DGCN(DGX),U,3)
- S DGLIN="",$P(DGLIN,"=",80)="" W !!,DGLIN
- W !!?3,"TOTALS:",?16,"______ + ",?30,DGTADM,?41,"(",DGTTR,")"
- W ?49,"-",?55,DGTDSC,?62,"= ______"
- I $D(DGCT("NEWBORN")) D ;
- .W !!?3,"NEWBORNS:",?16,"______ + ",?30,$P(DGCT("NEWBORN"),U)
- .W ?41,"(",$P(DGCT("NEWBORN"),U,2)-$P(DGCT("NEWBORN"),U,3),")"
- .W ?49,"-",?55,$P(DGCT("NEWBORN"),U,4),?62,"= ________"
- ;
- ;
- END I IOST["C-" D PRTOPT^ADGVAR
- END1 ;EP;***> end of program
- W @IOF D ^%ZISC
- D KILL^ADGUTIL K ^TMP($J) Q
- ;
- ;
- HEAD ;***> subrtn to print heading
- W @IOF S DGLIN="",$P(DGLIN,"=",80)="" W !,DGLIN S DGPAGE=DGPAGE+1
- W !?11,"*****Confidential Patient Data Covered by Privacy Act*****"
- W !,DGDUZ,?80-$L(DGSITE)/2,DGSITE S DGTY="WARD CENSUS LISTING"
- W ! D TIME^ADGUTIL W ?80-$L(DGTY)/2,DGTY,?70,"Page: ",DGPAGE
- S Y=DT X ^DD("DD") W !,Y
- S DGWARD="*** "_DGW_" ***" W ?80-$L(DGWARD)/2,DGWARD
- W !?80-$L(DGDATE)/2,DGDATE,!,DGLIN
- I DGW'="SUMMARY" W !?3," Time",?20,"Patient Name",?50,"Chart #" G HD1
- W !,"Ward",?15,"Beg Census Admits Net Transfers Discharges Ending Census"
- HD1 S DGLIN="",$P(DGLIN,"-",80)="" W !,DGLIN
- Q
- ADGCEN32 ; IHS/ADC/PDW/ENM - CENSUS WARD LISTING PRINT ; [ 03/25/1999 11:48 AM ]
- +1 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
- +2 ;
- +3 ;***> print summary page
- SUM ;no summary for one ward reports
- IF DGWD'="A"
- GOTO END
- +1 SET DGWN=0
- SET DGW="SUMMARY"
- DO HEAD
- WRITE !!
- S1 ;get wards' names
- SET DGWN=$ORDER(^DIC(42,"B",DGWN))
- IF DGWN=""
- GOTO S3
- SET DGWDFN=0
- S2 SET DGWDFN=$ORDER(^DIC(42,"B",DGWN,DGWDFN))
- IF DGWDFN=""
- GOTO S1
- +1 ;screen out inactive wards
- IF $DATA(^DIC(42,DGWDFN,"I"))
- IF (^("I")="I")
- GOTO S2
- +2 ;
- +3 WRITE !!?3,DGWN,?16,"______ +",?30,+$PIECE(DGCN(DGWN),U)
- +4 WRITE ?42,($PIECE(DGCN(DGWN),U,2)-$PIECE(DGCN(DGWN),U,3))
- +5 WRITE ?49,"-",?55,$PIECE(DGCN(DGWN),U,4),?65,"______"
- GOTO S2
- +6 ;
- S3 SET (DGX,DGTADM)=0
- +1 FOR
- SET DGX=$ORDER(DGCN(DGX))
- IF DGX=""
- QUIT
- SET DGTADM=DGTADM+$PIECE(DGCN(DGX),U)
- +2 SET (DGX,DGTDSC)=0
- +3 FOR
- SET DGX=$ORDER(DGCN(DGX))
- IF DGX=""
- QUIT
- SET DGTDSC=DGTDSC+$PIECE(DGCN(DGX),U,4)
- +4 SET (DGX,DGTTR)=0
- +5 FOR
- SET DGX=$ORDER(DGCN(DGX))
- IF DGX=""
- QUIT
- SET DGTTR=DGTTR+$PIECE(DGCN(DGX),U,2)-$PIECE(DGCN(DGX),U,3)
- +6 SET DGLIN=""
- SET $PIECE(DGLIN,"=",80)=""
- WRITE !!,DGLIN
- +7 WRITE !!?3,"TOTALS:",?16,"______ + ",?30,DGTADM,?41,"(",DGTTR,")"
- +8 WRITE ?49,"-",?55,DGTDSC,?62,"= ______"
- +9 ;
- IF $DATA(DGCT("NEWBORN"))
- Begin DoDot:1
- +10 WRITE !!?3,"NEWBORNS:",?16,"______ + ",?30,$PIECE(DGCT("NEWBORN"),U)
- +11 WRITE ?41,"(",$PIECE(DGCT("NEWBORN"),U,2)-$PIECE(DGCT("NEWBORN"),U,3),")"
- +12 WRITE ?49,"-",?55,$PIECE(DGCT("NEWBORN"),U,4),?62,"= ________"
- End DoDot:1
- +13 ;
- +14 ;
- END IF IOST["C-"
- DO PRTOPT^ADGVAR
- END1 ;EP;***> end of program
- +1 WRITE @IOF
- DO ^%ZISC
- +2 DO KILL^ADGUTIL
- KILL ^TMP($JOB)
- QUIT
- +3 ;
- +4 ;
- HEAD ;***> subrtn to print heading
- +1 WRITE @IOF
- SET DGLIN=""
- SET $PIECE(DGLIN,"=",80)=""
- WRITE !,DGLIN
- SET DGPAGE=DGPAGE+1
- +2 WRITE !?11,"*****Confidential Patient Data Covered by Privacy Act*****"
- +3 WRITE !,DGDUZ,?80-$LENGTH(DGSITE)/2,DGSITE
- SET DGTY="WARD CENSUS LISTING"
- +4 WRITE !
- DO TIME^ADGUTIL
- WRITE ?80-$LENGTH(DGTY)/2,DGTY,?70,"Page: ",DGPAGE
- +5 SET Y=DT
- XECUTE ^DD("DD")
- WRITE !,Y
- +6 SET DGWARD="*** "_DGW_" ***"
- WRITE ?80-$LENGTH(DGWARD)/2,DGWARD
- +7 WRITE !?80-$LENGTH(DGDATE)/2,DGDATE,!,DGLIN
- +8 IF DGW'="SUMMARY"
- WRITE !?3," Time",?20,"Patient Name",?50,"Chart #"
- GOTO HD1
- +9 WRITE !,"Ward",?15,"Beg Census Admits Net Transfers Discharges Ending Census"
- HD1 SET DGLIN=""
- SET $PIECE(DGLIN,"-",80)=""
- WRITE !,DGLIN
- +1 QUIT
