BDGILD ; IHS/ANMC/LJF - INPT LISTS BY DATE ;
;;5.3;PIMS;;APR 26, 2002
;
REPORT ; -- choose which report to print
NEW BDGRPT,BDGA,X,Y,BDGQUIT,BDGDESC
F X=1:1:9 S BDGA(X)=$J(X,3)_". "_$P($T(RPT+X),";;",2)
S Y=$$READ^BDGF("NO^1:9","Choose Report from List","","","",.BDGA)
Q:'Y I Y=9 S XQH="BDG INPT LISTS BY DATE" D EN^XQH G REPORT
S BDGRPT=$P($T(RPT+Y),";;",3),BDGDESC=$P($T(RPT+Y),";;",2)
;
S BDGQUIT=0 K BDGSRT,BDGTYP,BDGMAX,BDGBD,BDGED,BDGINS
D @Y I $G(BDGQUIT) D END Q ;ask more questions based on report chosen
;
S X=$$BROWSE^BDGF I X="B" D @BDGRPT,END Q
I X=U Q
;
D ZIS^BDGF("QP",BDGRPT,BDGDESC,"BDG*")
;
END ;
D HOME^%ZIS
K BDGTYP,BDGBD,BDGED,BDGSRT,BDGINS,BDGMAX
Q
;
1 ; admissions questions
NEW X
; set BDGBD and BDGED variables
D DATES Q:BDGQUIT
;
; set sort criteria
S X="1:By DATE Only;2:By WARD;3:By SERVICE;4:By ADMITTING Provider;5:By Provider's SERVICE;6:By Community;7:By Service Unit;8:By Patient Name"
S BDGTYP=$$READ^BDGF("SO^"_X,"Select Admission Report to Run")
I BDGTYP<1 S BDGQUIT=1 Q
;
; set sort range
S X=$S(BDGTYP=2:"WARD",BDGTYP=3:"SERV",BDGTYP=4:"PROV",BDGTYP=5:"PRVSV",BDGTYP=6:"COMM",BDGTYP=7:"SU",1:"") I X]"" D @X
;
S BDGINS=$$READ^BDGF("Y","Include Insurance Coverage on Report","NO")
I BDGINS=U S BDGQUIT=1 Q
;
Q
;
2 ; readmission questions
NEW X
W !!,"This includes admissions after release from Day Surgery.",!
;
; set BDGBD and BDGED variables
D DATES Q:BDGQUIT
;
; set sort criteria
S X="1:By DATE Only;2:By WARD;3:By SERVICE;4:By ADMITTING Provider;5:By Provider's SERVICE;6:BY Community;7:By Service Unit;8:By Patient Name"
S BDGTYP=$$READ^BDGF("SO^"_X,"Select Readmission Report to Run")
I BDGTYP<1 S BDGQUIT=1 Q
;
; set sort range
S X=$S(BDGTYP=2:"WARD",BDGTYP=3:"SERV",BDGTYP=4:"PROV",BDGTYP=5:"PRVSV",BDGTYP=6:"COMM",BDGTYP=7:"SU",1:"") I X]"" D @X
;
; set BDGMAX variable
S BDGMAX=$$READ^BDGF("N^1:365","MAXIMUM # of Days between admissions")
I BDGMAX<1 S BDGQUIT=1
;
S BDGINS=$$READ^BDGF("Y","Include Insurance Coverage on Report","NO")
I BDGINS=U S BDGQUIT=1 Q
Q
;
3 ; non-beneficiary admissions questions
NEW X
; set BDGBD and BDGED variables
D DATES Q:BDGQUIT
;
; set sort criteria
S X="1:By DATE Only;2:By WARD;3:By SERVICE;4:By ADMITTING Provider;5:By Provider's SERVICE;6:By Community;7:By Service Unit;8:By Patient Name"
S BDGTYP=$$READ^BDGF("SO^"_X,"Select Non-beneficiary Admission Report to Run")
I BDGTYP<1 S BDGQUIT=1 Q
;
; set sort range
S X=$S(BDGTYP=2:"WARD",BDGTYP=3:"SERV",BDGTYP=4:"PROV",BDGTYP=5:"PRVSV",BDGTYP=6:"COMM",BDGTYP=7:"SU",1:"") I X]"" D @X
;
S BDGINS=$$READ^BDGF("Y","Include Insurance Coverage on Report","YES")
I BDGINS=U S BDGQUIT=1 Q
Q
;
4 ; IUC Transfer questions
NEW X
; set BDGBD and BDGED variables
D DATES Q:BDGQUIT
;
S BDGTYP=$$READ^BDGF("SO^1:TRANSFERS to ICU;2:RETURNS to ICU","Select ICU Report to Run") I BDGTYP<1 S BDGQUIT=1 Q
Q:BDGTYP=1
;
; set BDGMAX variable
S BDGMAX=$$READ^BDGF("NO^1:30","MAXIMUM # of Days between ICU stays")
I BDGMAX<1 S BDGQUIT=1
Q
;
5 ; discharge questions
NEW X
; set BDGBD and BDGED variables
D DATES Q:BDGQUIT
;
; set sort criteria
S X="1:By DATE Only;2:By WARD;3:By SERVICE;4:By ATTENDING Provider;5:By Provider's SERVICE;6:By Community;7:By Service Unit;8:By Patient Name"
S BDGTYP=$$READ^BDGF("SO^"_X,"Select Discharges Report to Run")
I BDGTYP<1 S BDGQUIT=1 Q
;
; set sort range
S X=$S(BDGTYP=2:"WARD",BDGTYP=3:"SERV",BDGTYP=4:"PROV",BDGTYP=5:"PRVSV",BDGTYP=6:"COMM",BDGTYP=7:"SU",1:"") I X]"" D @X
;
S BDGINS=$$READ^BDGF("Y","Include Insurance Coverage on Report","NO")
I BDGINS=U S BDGQUIT=1
Q
;
6 ; interfacility transfers quesions
NEW X
; set BDGBD and BDGED variables
D DATES Q:BDGQUIT=1
;
S X="1:LISTING Only;2:STATISTICS Only;3:BOTH Listing and Stats"
S BDGTYP=$$READ^BDGF("SO^"_X,"Select Report to Run")
I BDGTYP<1 S BDGQUIT=1
Q
;
7 ; inpatient deaths questions
NEW X
; set BDGBD and BDGED variables
D DATES Q:BDGQUIT
;
;set sort criteria
S X="1:By DATE Only;2:By WARD;3:By SERVICE;4:By ATTENDING Provider;5:By Provider's SERVICE;6:By Community;7:By Service Unit;8:By Patient Name"
S BDGTYP=$$READ^BDGF("SO^"_X,"Select Discharges Report to Run")
I BDGTYP<1 S BDGQUIT=1 Q
;
; set sort range
S X=$S(BDGTYP=2:"WARD",BDGTYP=3:"SERV",BDGTYP=4:"PROV",BDGTYP=5:"PRVSV",BDGTYP=6:"COMM",BDGTYP=7:"SU",1:"") I X]"" D @X
;
S BDGINS=$$READ^BDGF("Y","Include Insurance Coverage on Report","YES")
I BDGINS=U S BDGQUIT=1
Q
;
8 ; los by discharge month questions
D ^XBCLS W !!?10,"LENGTH OF STAY BY DISCHARGE MONTH AND WARD"
W !!,"WARNING!! This report takes a LONG time to run, no matter how"
W !?11,"long a date range you select. Please run after hours.",!!
D DATES
Q
;
DATES ; ask for date range
S BDGBD=$$READ^BDGF("DO^::EX","Select Beginning Date")
I BDGBD<1 S BDGQUIT=1 Q
S BDGED=$$READ^BDGF("DO^::EX","Select Ending Date")
I BDGED<1 S BDGQUIT=1
Q
;
WARD ; ask ward questions
NEW Y,X
S Y=$$READ^BDGF("YO","Print for ALL Wards","NO") I Y=U S BDGQUIT=1 Q
I Y=1 S BDGSRT="A" Q
S Y=1 F Q:Y<1 D
. S X="Select "_$S($D(BDGSRT):"Another ",1:"")_"Ward Name"
. S Y=$$READ^BDGF("PO^42:EMQZ",X,"","","I $$ACTWD^BDGPAR(+Y)")
. I Y>0 S BDGSRT(+Y)=$P(Y,U,2)
I '$D(BDGSRT) S BDGQUIT=1
Q
;
SERV ; ask service questions
NEW Y,X
S Y=$$READ^BDGF("YO","Print for ALL Treating Specialties","NO")
I Y=U S BDGQUIT=1 Q
I Y=1 S BDGSRT="A" D Q
. S Y=$$READ^BDGF("S^1:Inpatient Services Only;2:Observations Only;3:Both","Select Service Type","Both") S $P(BDGSRT,U,2)=Y
S Y=1 F Q:Y<1 D
. S X="Select "_$S($D(BDGSRT):"Another ",1:"")_"Treating Specialty Name"
. S Y=$$READ^BDGF("PO^45.7:EMQZ",X,"","","I $$ACTSRV^BDGPAR(+Y,BDGBD)")
. I Y>0 S BDGSRT(+Y)=$P(Y,U,2)
I '$D(BDGSRT) S BDGQUIT=1
Q
;
PROV ; ask provider questions
NEW Y,X
S Y=$$READ^BDGF("YO","Print for ALL Providers","NO")
I Y=U S BDGQUIT=1 Q
I Y=1 S BDGSRT="A" Q
S Y=1 F Q:Y<1 D
. S X="Select "_$S($D(BDGSRT):"Another ",1:"")_"Provider Name"
. S Y=$$READ^BDGF("PO^200:EMQZ",X,"","","I $D(^XUSEC(""PROVIDER"",+Y))")
. I Y>0 S BDGSRT(+Y)=$P(Y,U,2)
I '$D(BDGSRT) S BDGQUIT=1
Q
;
PRVSV ; ask provider's service questions
NEW Y,X
S Y=$$READ^BDGF("YO","Print for ALL Hospital Services","NO")
I Y=U S BDGQUIT=1 Q
I Y=1 S BDGSRT="A" Q
S Y=1 F Q:Y<1 D
. S X="Select "_$S($D(BDGSRT):"Another ",1:"")_"Hospital Service Name"
. S Y=$$READ^BDGF("PO^49:EMQZ",X,"","","I $P(^DIC(49,+Y,0),U,9)=""C""")
. I Y>0 S BDGSRT(+Y)=$P(Y,U,2)
I '$D(BDGSRT) S BDGQUIT=1
Q
;
COMM ; ask user for community choices
NEW Y,X
S Y=$$READ^BDGF("YO","Print for ALL Communities","NO")
I Y=U S BDGQUIT=1 Q
I Y=1 S BDGSRT="A" Q
S Y=1 F Q:Y<1 D
. S X="Select "_$S($D(BDGSRT):"Another ",1:"")_"Community Name"
. S Y=$$READ^BDGF("PO^9999999.05:EMQZ",X)
. I Y>0 S BDGSRT(+Y)=$P(Y,U,2)
I '$D(BDGSRT) S BDGQUIT=1
Q
;
SU ; ask user for service unit choices
NEW Y,X
S Y=$$READ^BDGF("YO","Print for ALL Service Units","NO")
I Y=U S BDGQUIT=1 Q
I Y=1 S BDGSRT="A" Q
S Y=1 F Q:Y<1 D
. S X="Select "_$S($D(BDGSRT):"Another ",1:"")_"Service Unit Name"
. S Y=$$READ^BDGF("PO^9999999.22:EMQZ",X)
. I Y>0 S BDGSRT(+Y)=$P(Y,U,2)
I '$D(BDGSRT) S BDGQUIT=1
Q
;
RPT ;;
;;Admissions;;^BDGILD1;;
;;Readmissions;;^BDGILD2;;
;;Non-Beneficiary Admissions;;^BDGILD3;;
;;ICU Transfers;;^BDGILD4;;
;;Discharges;;^BDGILD5;;
;;Inter-Facility Transfers;;^BDGILD6;;
;;Inpatient Deaths;;^BDGILD7;;
;;LOS by Discharge Month & Ward;;^BDGLOS1;;
;;On-line Help (Report Descriptions);;
BDGILD ; IHS/ANMC/LJF - INPT LISTS BY DATE ;
+1 ;;5.3;PIMS;;APR 26, 2002
+2 ;
REPORT ; -- choose which report to print
+1 NEW BDGRPT,BDGA,X,Y,BDGQUIT,BDGDESC
+2 FOR X=1:1:9
SET BDGA(X)=$JUSTIFY(X,3)_". "_$PIECE($TEXT(RPT+X),";;",2)
+3 SET Y=$$READ^BDGF("NO^1:9","Choose Report from List","","","",.BDGA)
+4 IF 'Y
QUIT
IF Y=9
SET XQH="BDG INPT LISTS BY DATE"
DO EN^XQH
GOTO REPORT
+5 SET BDGRPT=$PIECE($TEXT(RPT+Y),";;",3)
SET BDGDESC=$PIECE($TEXT(RPT+Y),";;",2)
+6 ;
+7 SET BDGQUIT=0
KILL BDGSRT,BDGTYP,BDGMAX,BDGBD,BDGED,BDGINS
+8 ;ask more questions based on report chosen
DO @Y
IF $GET(BDGQUIT)
DO END
QUIT
+9 ;
+10 SET X=$$BROWSE^BDGF
IF X="B"
DO @BDGRPT
DO END
QUIT
+11 IF X=U
QUIT
+12 ;
+13 DO ZIS^BDGF("QP",BDGRPT,BDGDESC,"BDG*")
+14 ;
END ;
+1 DO HOME^%ZIS
+2 KILL BDGTYP,BDGBD,BDGED,BDGSRT,BDGINS,BDGMAX
+3 QUIT
+4 ;
1 ; admissions questions
+1 NEW X
+2 ; set BDGBD and BDGED variables
+3 DO DATES
IF BDGQUIT
QUIT
+4 ;
+5 ; set sort criteria
+6 SET X="1:By DATE Only;2:By WARD;3:By SERVICE;4:By ADMITTING Provider;5:By Provider's SERVICE;6:By Community;7:By Service Unit;8:By Patient Name"
+7 SET BDGTYP=$$READ^BDGF("SO^"_X,"Select Admission Report to Run")
+8 IF BDGTYP<1
SET BDGQUIT=1
QUIT
+9 ;
+10 ; set sort range
+11 SET X=$SELECT(BDGTYP=2:"WARD",BDGTYP=3:"SERV",BDGTYP=4:"PROV",BDGTYP=5:"PRVSV",BDGTYP=6:"COMM",BDGTYP=7:"SU",1:"")
IF X]""
DO @X
+12 ;
+13 SET BDGINS=$$READ^BDGF("Y","Include Insurance Coverage on Report","NO")
+14 IF BDGINS=U
SET BDGQUIT=1
QUIT
+15 ;
+16 QUIT
+17 ;
2 ; readmission questions
+1 NEW X
+2 WRITE !!,"This includes admissions after release from Day Surgery.",!
+3 ;
+4 ; set BDGBD and BDGED variables
+5 DO DATES
IF BDGQUIT
QUIT
+6 ;
+7 ; set sort criteria
+8 SET X="1:By DATE Only;2:By WARD;3:By SERVICE;4:By ADMITTING Provider;5:By Provider's SERVICE;6:BY Community;7:By Service Unit;8:By Patient Name"
+9 SET BDGTYP=$$READ^BDGF("SO^"_X,"Select Readmission Report to Run")
+10 IF BDGTYP<1
SET BDGQUIT=1
QUIT
+11 ;
+12 ; set sort range
+13 SET X=$SELECT(BDGTYP=2:"WARD",BDGTYP=3:"SERV",BDGTYP=4:"PROV",BDGTYP=5:"PRVSV",BDGTYP=6:"COMM",BDGTYP=7:"SU",1:"")
IF X]""
DO @X
+14 ;
+15 ; set BDGMAX variable
+16 SET BDGMAX=$$READ^BDGF("N^1:365","MAXIMUM # of Days between admissions")
+17 IF BDGMAX<1
SET BDGQUIT=1
+18 ;
+19 SET BDGINS=$$READ^BDGF("Y","Include Insurance Coverage on Report","NO")
+20 IF BDGINS=U
SET BDGQUIT=1
QUIT
+21 QUIT
+22 ;
3 ; non-beneficiary admissions questions
+1 NEW X
+2 ; set BDGBD and BDGED variables
+3 DO DATES
IF BDGQUIT
QUIT
+4 ;
+5 ; set sort criteria
+6 SET X="1:By DATE Only;2:By WARD;3:By SERVICE;4:By ADMITTING Provider;5:By Provider's SERVICE;6:By Community;7:By Service Unit;8:By Patient Name"
+7 SET BDGTYP=$$READ^BDGF("SO^"_X,"Select Non-beneficiary Admission Report to Run")
+8 IF BDGTYP<1
SET BDGQUIT=1
QUIT
+9 ;
+10 ; set sort range
+11 SET X=$SELECT(BDGTYP=2:"WARD",BDGTYP=3:"SERV",BDGTYP=4:"PROV",BDGTYP=5:"PRVSV",BDGTYP=6:"COMM",BDGTYP=7:"SU",1:"")
IF X]""
DO @X
+12 ;
+13 SET BDGINS=$$READ^BDGF("Y","Include Insurance Coverage on Report","YES")
+14 IF BDGINS=U
SET BDGQUIT=1
QUIT
+15 QUIT
+16 ;
4 ; IUC Transfer questions
+1 NEW X
+2 ; set BDGBD and BDGED variables
+3 DO DATES
IF BDGQUIT
QUIT
+4 ;
+5 SET BDGTYP=$$READ^BDGF("SO^1:TRANSFERS to ICU;2:RETURNS to ICU","Select ICU Report to Run")
IF BDGTYP<1
SET BDGQUIT=1
QUIT
+6 IF BDGTYP=1
QUIT
+7 ;
+8 ; set BDGMAX variable
+9 SET BDGMAX=$$READ^BDGF("NO^1:30","MAXIMUM # of Days between ICU stays")
+10 IF BDGMAX<1
SET BDGQUIT=1
+11 QUIT
+12 ;
5 ; discharge questions
+1 NEW X
+2 ; set BDGBD and BDGED variables
+3 DO DATES
IF BDGQUIT
QUIT
+4 ;
+5 ; set sort criteria
+6 SET X="1:By DATE Only;2:By WARD;3:By SERVICE;4:By ATTENDING Provider;5:By Provider's SERVICE;6:By Community;7:By Service Unit;8:By Patient Name"
+7 SET BDGTYP=$$READ^BDGF("SO^"_X,"Select Discharges Report to Run")
+8 IF BDGTYP<1
SET BDGQUIT=1
QUIT
+9 ;
+10 ; set sort range
+11 SET X=$SELECT(BDGTYP=2:"WARD",BDGTYP=3:"SERV",BDGTYP=4:"PROV",BDGTYP=5:"PRVSV",BDGTYP=6:"COMM",BDGTYP=7:"SU",1:"")
IF X]""
DO @X
+12 ;
+13 SET BDGINS=$$READ^BDGF("Y","Include Insurance Coverage on Report","NO")
+14 IF BDGINS=U
SET BDGQUIT=1
+15 QUIT
+16 ;
6 ; interfacility transfers quesions
+1 NEW X
+2 ; set BDGBD and BDGED variables
+3 DO DATES
IF BDGQUIT=1
QUIT
+4 ;
+5 SET X="1:LISTING Only;2:STATISTICS Only;3:BOTH Listing and Stats"
+6 SET BDGTYP=$$READ^BDGF("SO^"_X,"Select Report to Run")
+7 IF BDGTYP<1
SET BDGQUIT=1
+8 QUIT
+9 ;
7 ; inpatient deaths questions
+1 NEW X
+2 ; set BDGBD and BDGED variables
+3 DO DATES
IF BDGQUIT
QUIT
+4 ;
+5 ;set sort criteria
+6 SET X="1:By DATE Only;2:By WARD;3:By SERVICE;4:By ATTENDING Provider;5:By Provider's SERVICE;6:By Community;7:By Service Unit;8:By Patient Name"
+7 SET BDGTYP=$$READ^BDGF("SO^"_X,"Select Discharges Report to Run")
+8 IF BDGTYP<1
SET BDGQUIT=1
QUIT
+9 ;
+10 ; set sort range
+11 SET X=$SELECT(BDGTYP=2:"WARD",BDGTYP=3:"SERV",BDGTYP=4:"PROV",BDGTYP=5:"PRVSV",BDGTYP=6:"COMM",BDGTYP=7:"SU",1:"")
IF X]""
DO @X
+12 ;
+13 SET BDGINS=$$READ^BDGF("Y","Include Insurance Coverage on Report","YES")
+14 IF BDGINS=U
SET BDGQUIT=1
+15 QUIT
+16 ;
8 ; los by discharge month questions
+1 DO ^XBCLS
WRITE !!?10,"LENGTH OF STAY BY DISCHARGE MONTH AND WARD"
+2 WRITE !!,"WARNING!! This report takes a LONG time to run, no matter how"
+3 WRITE !?11,"long a date range you select. Please run after hours.",!!
+4 DO DATES
+5 QUIT
+6 ;
DATES ; ask for date range
+1 SET BDGBD=$$READ^BDGF("DO^::EX","Select Beginning Date")
+2 IF BDGBD<1
SET BDGQUIT=1
QUIT
+3 SET BDGED=$$READ^BDGF("DO^::EX","Select Ending Date")
+4 IF BDGED<1
SET BDGQUIT=1
+5 QUIT
+6 ;
WARD ; ask ward questions
+1 NEW Y,X
+2 SET Y=$$READ^BDGF("YO","Print for ALL Wards","NO")
IF Y=U
SET BDGQUIT=1
QUIT
+3 IF Y=1
SET BDGSRT="A"
QUIT
+4 SET Y=1
FOR
IF Y<1
QUIT
Begin DoDot:1
+5 SET X="Select "_$SELECT($DATA(BDGSRT):"Another ",1:"")_"Ward Name"
+6 SET Y=$$READ^BDGF("PO^42:EMQZ",X,"","","I $$ACTWD^BDGPAR(+Y)")
+7 IF Y>0
SET BDGSRT(+Y)=$PIECE(Y,U,2)
End DoDot:1
+8 IF '$DATA(BDGSRT)
SET BDGQUIT=1
+9 QUIT
+10 ;
SERV ; ask service questions
+1 NEW Y,X
+2 SET Y=$$READ^BDGF("YO","Print for ALL Treating Specialties","NO")
+3 IF Y=U
SET BDGQUIT=1
QUIT
+4 IF Y=1
SET BDGSRT="A"
Begin DoDot:1
+5 SET Y=$$READ^BDGF("S^1:Inpatient Services Only;2:Observations Only;3:Both","Select Service Type","Both")
SET $PIECE(BDGSRT,U,2)=Y
End DoDot:1
QUIT
+6 SET Y=1
FOR
IF Y<1
QUIT
Begin DoDot:1
+7 SET X="Select "_$SELECT($DATA(BDGSRT):"Another ",1:"")_"Treating Specialty Name"
+8 SET Y=$$READ^BDGF("PO^45.7:EMQZ",X,"","","I $$ACTSRV^BDGPAR(+Y,BDGBD)")
+9 IF Y>0
SET BDGSRT(+Y)=$PIECE(Y,U,2)
End DoDot:1
+10 IF '$DATA(BDGSRT)
SET BDGQUIT=1
+11 QUIT
+12 ;
PROV ; ask provider questions
+1 NEW Y,X
+2 SET Y=$$READ^BDGF("YO","Print for ALL Providers","NO")
+3 IF Y=U
SET BDGQUIT=1
QUIT
+4 IF Y=1
SET BDGSRT="A"
QUIT
+5 SET Y=1
FOR
IF Y<1
QUIT
Begin DoDot:1
+6 SET X="Select "_$SELECT($DATA(BDGSRT):"Another ",1:"")_"Provider Name"
+7 SET Y=$$READ^BDGF("PO^200:EMQZ",X,"","","I $D(^XUSEC(""PROVIDER"",+Y))")
+8 IF Y>0
SET BDGSRT(+Y)=$PIECE(Y,U,2)
End DoDot:1
+9 IF '$DATA(BDGSRT)
SET BDGQUIT=1
+10 QUIT
+11 ;
PRVSV ; ask provider's service questions
+1 NEW Y,X
+2 SET Y=$$READ^BDGF("YO","Print for ALL Hospital Services","NO")
+3 IF Y=U
SET BDGQUIT=1
QUIT
+4 IF Y=1
SET BDGSRT="A"
QUIT
+5 SET Y=1
FOR
IF Y<1
QUIT
Begin DoDot:1
+6 SET X="Select "_$SELECT($DATA(BDGSRT):"Another ",1:"")_"Hospital Service Name"
+7 SET Y=$$READ^BDGF("PO^49:EMQZ",X,"","","I $P(^DIC(49,+Y,0),U,9)=""C""")
+8 IF Y>0
SET BDGSRT(+Y)=$PIECE(Y,U,2)
End DoDot:1
+9 IF '$DATA(BDGSRT)
SET BDGQUIT=1
+10 QUIT
+11 ;
COMM ; ask user for community choices
+1 NEW Y,X
+2 SET Y=$$READ^BDGF("YO","Print for ALL Communities","NO")
+3 IF Y=U
SET BDGQUIT=1
QUIT
+4 IF Y=1
SET BDGSRT="A"
QUIT
+5 SET Y=1
FOR
IF Y<1
QUIT
Begin DoDot:1
+6 SET X="Select "_$SELECT($DATA(BDGSRT):"Another ",1:"")_"Community Name"
+7 SET Y=$$READ^BDGF("PO^9999999.05:EMQZ",X)
+8 IF Y>0
SET BDGSRT(+Y)=$PIECE(Y,U,2)
End DoDot:1
+9 IF '$DATA(BDGSRT)
SET BDGQUIT=1
+10 QUIT
+11 ;
SU ; ask user for service unit choices
+1 NEW Y,X
+2 SET Y=$$READ^BDGF("YO","Print for ALL Service Units","NO")
+3 IF Y=U
SET BDGQUIT=1
QUIT
+4 IF Y=1
SET BDGSRT="A"
QUIT
+5 SET Y=1
FOR
IF Y<1
QUIT
Begin DoDot:1
+6 SET X="Select "_$SELECT($DATA(BDGSRT):"Another ",1:"")_"Service Unit Name"
+7 SET Y=$$READ^BDGF("PO^9999999.22:EMQZ",X)
+8 IF Y>0
SET BDGSRT(+Y)=$PIECE(Y,U,2)
End DoDot:1
+9 IF '$DATA(BDGSRT)
SET BDGQUIT=1
+10 QUIT
+11 ;
RPT ;;
+1 ;;Admissions;;^BDGILD1;;
+2 ;;Readmissions;;^BDGILD2;;
+3 ;;Non-Beneficiary Admissions;;^BDGILD3;;
+4 ;;ICU Transfers;;^BDGILD4;;
+5 ;;Discharges;;^BDGILD5;;
+6 ;;Inter-Facility Transfers;;^BDGILD6;;
+7 ;;Inpatient Deaths;;^BDGILD7;;
+8 ;;LOS by Discharge Month & Ward;;^BDGLOS1;;
+9 ;;On-line Help (Report Descriptions);;
