Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BDGIPL

BDGIPL.m

Go to the documentation of this file. 
  1. BDGIPL ; IHS/ANMC/LJF - CURRENT INPT LISTS ;  [ 11/01/2002  4:09 PM ]
  1.  ;;5.3;PIMS;**1007**;APR 26, 2002
  1.  ;
  1.  ;cmi/anch/maw 2/21/2007 added code to 3 PATCH 1007 item 1007.38
  1.  ;cmi/anch/maw 2/22/2007 added code to REPORT to ask for # of copies PATCH 1007 item 1007.39
  1.  ;cmi/anch/maw 2/22/2007 added code to 7 to ask for sort var BSDSRT patch 1007 item 1007.40
  1.  ;
  1. REPORT ; -- choose which report to print
  1.  NEW BDGRPT,BDGA,X,Y,BDGQUIT,BDGDESC
  1.  W !! F X=1:1:10 S BDGA(X)=$J(X,3)_". "_$P($T(RPT+X),";;",2)
  1.  S Y=$$READ^BDGF("NO^1:10","Choose Report from List","","","",.BDGA)
  1.  Q:'Y  I Y=10 S XQH="BDG INPT LISTS" D EN^XQH G REPORT
  1.  S BDGRPT=$P($T(RPT+Y),";;",3),BDGDESC=$P($T(RPT+Y),";;",2)
  1.  ;
  1.  D @Y I $G(BDGQUIT) D END Q  ;ask more questions based on report chosen
  1.  ;
  1.  S X=$$BROWSE^BDGF I X="B" D @BDGRPT,END Q
  1.  I X=U Q
  1.  ;
  1.  S BDGCOP=$$READ^BDGF("N^1:99","How many copies of the report",1)  ;cmi/anch/maw 2/22/2007 added to print multiple copies of report
  1.  ;
  1.  D ZIS^BDGF("QP",BDGRPT,BDGDESC,"BDG*")
  1.  ;
  1. END ;
  1.  I $G(BDGCOP) D ^%ZISC
  1.  D HOME^%ZIS
  1.  K BDGSRT,BDGSRT2,BDGCOP
  1.  Q
  1.  ;
  1. 1 ; alpha report questions
  1.  Q
  1.  ;
  1. 2 ; inpt roster (ward then name) questions
  1.  D WARD Q:$G(BDGQUIT)
  1.  ;
  1.  S BDGSRT2=$$READ^BDGF("YO","Would you like the report DOUBLE SPACED","NO")
  1.  I BDGSRT2=U S BDGQUIT=1
  1.  Q
  1.  ;
  1. 3 ; plw questions (ward then room)
  1.  D WARD Q:$G(BDGQUIT)
  1.  ;cmi/anch/maw 2/21/2007 added the following line to ask if they want to separate report by ward
  1.  S BDGONE=$$READ^BDGF("Y","Print each ward on a separate piece of paper","YES")
  1.  I $D(^XUSEC("DGZNOCLN",DUZ)) S BDGSRT2=2 Q  ;service if no clin access
  1.  S BDGSRT2=$$READ^BDGF("SO^1:With Diagnosis;2:With Service;3:Nursing Notes;4:Brief Listing","Select Last Column Data","","^D HELP3^BDGIPL")
  1.  I 'BDGSRT2 S BDGQUIT=1
  1.  Q
  1.  ;
  1. HELP3 ;EP; help for last column question for report 3
  1.  D MSG^BDGF("Please select the data you want contained in the last",2,0)
  1.  D MSG^BDGF("column of this report.",1,1)
  1.  D MSG^BDGF(" Choose 1 to print admitting diagnosis.",1,0)
  1.  D MSG^BDGF(" Choose 2 to print patient's current service.",1,0)
  1.  D MSG^BDGF(" Choose 3 to leave the column blank for notes.",1,0)
  1.  Q
  1.  ;
  1. 4 ; pls questions (by service)
  1.  S Y=$$READ^BDGF("YO","Print for ALL Treating Specialties","NO")
  1.  I Y=U S BDGQUIT=1 Q
  1.  I Y=1 S BDGSRT="A" D  Q
  1.  . S BDGSRT2=$$READ^BDGF("S^1:Inpatient Services Only;2:Observation Services Only;3:Both","Select Service Type","Both")
  1.  ;
  1.  ;11/1/2002 WAR - per LJF30, P37
  1.  ;IHS/ANMC/LJF 10/31/2002 adding ability to choose >1 service
  1.  ;S BDGSRT=$$READ^BDGF("PO^45.7:EMQZ","Select Treating Specialty")
  1.  ;I BDGSRT<1 S BDGQUIT=1 Q
  1.  S Y=1 F  Q:Y<1  D
  1.  . S X="Select "_$S($D(BDGSRT):"Another ",1:"")_"Treating Specialty Name"
  1.  . S Y=$$READ^BDGF("PO^45.7:EMQZ",X,"","","I $$ACTSRV^BDGPAR(+Y,DT)")
  1.  . I Y>0 S BDGSRT(+Y)=$P(Y,U,2),BDGSRT=0
  1.  I '$D(BDGSRT) S BDGQUIT=1
  1.  ;IHS/ANMC/LJF 10/31/2002 end of mods
  1.  Q
  1.  ;
  1. 5 ; service then provider questions
  1.  I $D(^XUSEC("DGZNOCLN",DUZ)) D  Q
  1.  . S BDGQUIT=1
  1.  . D MSG^BDGF("Sorry, you do not have access to this report.",2,0)
  1.  . D PAUSE^BDGF
  1.  ;
  1.  D 4 Q:$G(BDGQUIT)
  1.  S Y=$$READ^BDGF("YO","Print for ALL Attending Providers","NO")
  1.  I Y=U S BDGQUIT=1 Q
  1.  I Y=1 S BDGSRT1="A" Q
  1.  S BDGSRT1=$$READ^BDGF("PO^200:EMQZ","Select Provider","","","I $D(^XUSEC(""PROVIDER"",+Y))")
  1.  I BDGSRT1<1 S BDGQUIT=1 Q
  1.  Q
  1.  ;
  1. 6 ; chaplain's report questions
  1.  NEW Y
  1.  S Y=$$READ^BDGF("YO","Print ALL Religions","NO") I Y=U S BDGQUIT=1 Q
  1.  I Y=1 S BDGSRT="A" Q
  1.  S BDGSRT=$$READ^BDGF("P^13:EMQZ","Select RELIGION")
  1.  I BDGSRT<1 S BDGQUIT=1
  1.  Q
  1.  ;
  1. 7 ; medicare/medicaid report questions
  1.  I $D(^XUSEC("DGZNOCLN",DUZ)) D  Q
  1.  . S BDGQUIT=1
  1.  . D MSG^BDGF("Sorry, you do not have access to this report.",2,0)
  1.  . D PAUSE^BDGF
  1.  ;
  1.  D WARD Q:$G(BDGQUIT)
  1.  ;cmi/anch/maw 2/22/2007 PATCH 1007 item 1007.40
  1.  S BDGSRT2=$$READ^BDGF("S^W:Ward;C:Coverage Type","Sort By","Ward")
  1.  Q
  1.  ;
  1. 8 ; LOS >n days report questions
  1.  D WARD Q:$G(BDGQUIT)
  1.  ;
  1.  S BDGSRT2=$$READ^BDGF("NO","What is the minimun length of Stay for this report")
  1.  I 'BDGSRT2 S BDGQUIT=1
  1.  Q
  1.  ;
  1. 9 ; seriously ill list questions
  1.  I $D(^XUSEC("DGZNOCLN",DUZ)) D  Q
  1.  . S BDGQUIT=1
  1.  . D MSG^BDGF("Sorry, you do not have access to this report.",2,0)
  1.  . D PAUSE^BDGF
  1.  ;
  1.  D WARD Q:$G(BDGQUIT)
  1.  S BDGSRT2=$$READ^BDGF("YO","Include DNR Patients on List","YES")
  1.  I BDGSRT2=U S BDGQUIT=1
  1.  Q
  1.  ;
  1. WARD ; ask ward questions
  1.  NEW Y
  1.  S Y=$$READ^BDGF("YO","Print for ALL Wards","NO")
  1.  I Y=U S BDGQUIT=1 Q
  1.  I Y=1 S BDGSRT="A"
  1.  E  D
  1.  . S BDGSRT=$$READ^BDGF("PO^42:EMQZ","Select Ward Name","","","I $$ACTWD^BDGPAR(+Y)")
  1.  . I BDGSRT<1 S BDGQUIT=1 Q
  1.  Q
  1.  ;
  1. RPT ;;
  1.  ;;Alphabetical Listing;;^BDGIPL1;;
  1.  ;;List by Ward and Patient;;^BDGIPL2;;
  1.  ;;List by Ward and Room;;^BDGIPL3;;
  1.  ;;List by Service and Patient;;^BDGIPL4;;
  1.  ;;List by Service and Provider;;^BDGIPL5;;
  1.  ;;Chaplain's List;;^BDGIPL6;;
  1.  ;;Insurance Coverage List;;^BDGIPL7;;
  1.  ;;LOS >n Days Listing;;^BDGIPL8;;
  1.  ;;Seriously Ill/DNR List;;^BDGIPL9;;
  1.  ;;On-line Help (Report Descriptions);;