- 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);;
