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

BDGICR5.m

Go to the documentation of this file. 
  1. BDGICR5 ; IHS/ANMC/LJF - CHARTS COMPLETED BY DATE ; 
  1.  ;;5.3;PIMS;**1005**;MAY 28,2004
  1.  ;IHS/OIT/LJF 04/14/2006 PATCH 1005 added display of observations
  1.  ;
  1.  NEW BDGSTG,BDGBD,BDGED,DEFAULT,BDGTYP,BDGSRT
  1.  S BDGSTG=$$READ^BDGF("SO^1:Coded;2:Completed;3:Bill Prep Done","Select Completion Stage") Q:BDGSTG<1
  1.  ;
  1.  S DEFAULT=$S(BDGSTG=1:"Coded",BDGSTG=2:"Completed",1:"Bill Prep Done")
  1.  S BDGBD=$$READ^BDGF("DO^::E","Enter Beginning Date "_DEFAULT)
  1.  Q:'BDGBD
  1.  S BDGED=$$READ^BDGF("DO^::E","Enter Ending Date "_DEFAULT)
  1.  Q:'BDGED
  1.  ;
  1.  S BDGSRT=$$READ^BDGF("SO^1:Alphabetical;2:By Date "_DEFAULT,"Select Sorting Choice")
  1.  Q:BDGSRT<1
  1.  ;
  1.  ;IHS/OIT/LJF 04/14/2006 PATCH 1005 add observations
  1.  ;S BDGTYP=$$READ^BDGF("SO^1:Inpatients Only;2:Day Surgeries Only;3:Both","Select Visit Types To Include") Q:'BDGTYP
  1.  S BDGTYP=$$READ^BDGF("SO^1:Inpatients Only;2:Day Surgeries & Observations;3:All Types","Select Visit Types To Include") Q:'BDGTYP
  1.  ;
  1.  I $$BROWSE^BDGF="B" D EN Q
  1.  D ZIS^BDGF("PQ","EN^BDGICR5","DAILY/WEEKLY IC REPORT","BDGSTG;BDGBD;BDGED;BDGTYP;BDGSRT")
  1.  Q
  1.  ;
  1. EN ;EP; -- main entry point for BDG IC COMPLETED WEEKLY
  1.  I $E(IOST,1,2)="P-" S BDGPRT=1 D INIT,PRINT Q   ;printing to paper
  1.  NEW VALMCNT D TERM^VALM0,CLEAR^VALM1
  1.  D EN^VALM("BDG IC COMPLETED WEEKLY")
  1.  D CLEAR^VALM1
  1.  Q
  1.  ;
  1. HDR ; -- header code
  1.  NEW X
  1.  S VALMHDR(1)=$$SP(15)_$$CONF^BDGF
  1.  ;
  1.  ;IHS/OIT/LJF 04/14/2006 PATCH 1005 added observations
  1.  ;S X=$S(BDGTYP=1:"Inpatients Only",BDGTYP=2:"Day Surgeries Only",1:"Inpatients & Day Surgeries")
  1.  S X=$S(BDGTYP=1:"Inpatients Only",BDGTYP=2:"Day Surgeries & Observations",1:"Inpatients, Observations & Day Surgeries")
  1.  ;
  1.  S X=X_$$SP(4)_"-"_$$SP(4)_$P($T(CHOICE+BDGSTG),";;",2)
  1.  S VALMHDR(2)=$$SP(75-$L(X)\2)_X
  1.  S X=$$RANGE^BDGF(BDGBD,BDGED)     ;date range
  1.  S VALMHDR(3)=$$SP(75-$L(X)\2)_X
  1.  ;
  1.  S X=$S(BDGSTG=1:" Coded",BDGSTG=2:" Complt",1:" BillPrep")
  1.  S X=$$PAD($$PAD($$PAD(X,13)_"HRCN",19)_"Patient Name",46)
  1.  S X=$$PAD($$PAD($$PAD(X_"Typ",51)_"Dsch/Sur",62)_"WHO",67)
  1.  S X=X_$S(BDGSTG=1:"Compl BPrep",BDGSTG=2:$$SP(6)_"BPrep",1:"")
  1.  S VALMCAP=$$PAD(X,79)
  1.  Q
  1.  ;
  1. INIT ; -- init variables and list array
  1.  I '$G(BDGPRT) D MSG^BDGF("Please wait; compiling list...",2,0)
  1.  NEW XREF,DATE,IEN,LINE,X,SORT1,SORT2,COUNT
  1.  S VALMCNT=0 K ^TMP("BDGICR5",$J),^TMP("BDGICR5A",$J)
  1.  ;
  1.  ; find charts at completion stage for date range & sort
  1.  S XREF=$S(BDGSTG=1:"AC",BDGSTG=2:"AE",1:"AF")
  1.  S DATE=BDGBD-.0001
  1.  F  S DATE=$O(^BDGIC(XREF,DATE)) Q:'DATE  Q:DATE>BDGED  D
  1.  . S IEN=0 F  S IEN=$O(^BDGIC(XREF,DATE,IEN)) Q:'IEN  D
  1.  .. ; screen out entries
  1.  .. Q:$$GET1^DIQ(9009016.1,IEN,.17)]""     ;deleted
  1.  .. ;
  1.  .. ;IHS/OIT/LJF 04/14/2006 PATCH 1005 use different logic to screen for visit type
  1.  .. ;I BDGTYP=1 Q:$$GET1^DIQ(9009016.1,IEN,.02)=""  ;ip needs disch date
  1.  .. ;I BDGTYP=2 Q:$$GET1^DIQ(9009016.1,IEN,.04)=""  ;ds needs surg date
  1.  .. ;I BDGTYP=2 Q:$$GET1^DIQ(9009016.1,IEN,.02)]""  ;no sda for ds
  1.  .. NEW CAT S CAT=$$GET1^DIQ(9009016.1,IEN,.0392)              ;visit service category
  1.  .. I (BDGTYP=1),(CAT'="HOSPITALIZATION") Q                    ;skip if asked for inpt and not H visit
  1.  .. I (BDGTYP=2),(CAT'="DAY SURGERY"),(CAT'="OBSERVATION") Q   ;skip if not correct service category
  1.  .. ;
  1.  .. I BDGSRT=1 S (SORT1,SORT2)=$$GET1^DIQ(9009016.1,IEN,.01)
  1.  .. E  D
  1.  ... I BDGSTG=1 S SORT1=$$GET1^DIQ(9009016.1,IEN,.13,"I") Q:SORT1=""
  1.  ... I BDGSTG=2 S SORT1=$$GET1^DIQ(9009016.1,IEN,.14,"I") Q:SORT1=""
  1.  ... I BDGSTG=3 S SORT1=$$GET1^DIQ(9009016.1,IEN,.15,"I") Q:SORT1=""
  1.  ... ;
  1.  ... ; sort by completion date and then by disch/surg date
  1.  ... S SORT2=$$GET1^DIQ(9009016.1,IEN,.02,"I")
  1.  ... I SORT2="" S SORT2=$$GET1^DIQ(9009016.1,IEN,.05,"I")
  1.  ... I SORT2="" S SORT2="??"
  1.  .. ;
  1.  .. ; store by primary & secondary sorts
  1.  .. S ^TMP("BDGICR5A",$J,SORT1,SORT2,IEN)=DATE
  1.  ;
  1.  ; now take sorted list and create display lines
  1.  S COUNT=0
  1.  S SORT1=0 F  S SORT1=$O(^TMP("BDGICR5A",$J,SORT1)) Q:SORT1=""  D
  1.  . S SORT2=0
  1.  . F  S SORT2=$O(^TMP("BDGICR5A",$J,SORT1,SORT2)) Q:SORT2=""  D
  1.  .. S IEN=0 F  S IEN=$O(^TMP("BDGICR5A",$J,SORT1,SORT2,IEN)) Q:'IEN  D
  1.  ... S DATE=^TMP("BDGICR5A",$J,SORT1,SORT2,IEN)
  1.  ... S LINE=$$NUMDATE^BDGF(DATE,1)                         ;date
  1.  ... S LINE=$$PAD(LINE,10)_$J($$GET1^DIQ(9009016.1,IEN,.011),7)  ;hrcn
  1.  ... S LINE=$$PAD(LINE,19)_$E($$GET1^DIQ(9009016.1,IEN,.01),1,25)
  1.  ... S X=$$GET1^DIQ(9009016.1,IEN,.0392)                   ;visit type
  1.  ... ;S LINE=$$PAD(LINE,46)_$S(X["HOSP":"IP",X["OBSER":"DSO",1:"DS")
  1.  ... S LINE=$$PAD(LINE,46)_$S(X["HOSP":"IP",X["OBSER":"OBS",1:"DS")
  1.  ... S X=$$GET1^DIQ(9009016.1,IEN,.02,"I")                 ;disch date
  1.  ... I X="" S X=$$GET1^DIQ(9009016.1,IEN,.05,"I")          ;surg date
  1.  ... I X="" S LINE=$$PAD(LINE,51)_"??"
  1.  ... E  S LINE=$$PAD(LINE,51)_$$NUMDATE^BDGF(X\1,1)
  1.  ... I BDGSTG<3 S X=$$GET1^DIQ(9009016.1,IEN,.22,"I")      ;coder
  1.  ... I BDGSTG=3 S X=$$GET1^DIQ(9009016.1,IEN,.23,"I")      ;bill prep
  1.  ... I X S LINE=$$PAD(LINE,62)_$$GET1^DIQ(200,X,1)         ;initials
  1.  ... ;
  1.  ... ; if listing coded charts, show any that are completed also
  1.  ... I BDGSTG=1,$$GET1^DIQ(9009016.1,IEN,.14)]"" S LINE=$$PAD(LINE,69)_"X"
  1.  ... ; if listing coded or completed charts, show any already bill prepd
  1.  ... I BDGSTG<3,$$GET1^DIQ(9009016.1,IEN,.15)]"" S LINE=$$PAD(LINE,75)_"X"
  1.  ... D SET(LINE,.VALMCNT)
  1.  ... S COUNT=COUNT+1,COUNT(SORT1)=$G(COUNT(SORT1))+1
  1.  ;
  1.  I COUNT D
  1.  . D SET("",.VALMCNT),SET("Total Charts:"_$J(COUNT,4),.VALMCNT)
  1.  . S X=0 F  S X=$O(COUNT(X)) Q:'X  D
  1.  .. S LINE=$$SP(3)_$$NUMDATE^BDGF(X\1)_":"_$J(COUNT(X),5)
  1.  .. D SET(LINE,.VALMCNT)
  1.  ;
  1.  I '$D(^TMP("BDGICR5",$J)) S VALMCNT=1,^TMP("BDGICR5",$J,1,0)="NO DATA FOUND"
  1.  K ^TMP("BDGICR5A",$J)
  1.  Q
  1.  ;
  1. HELP ; -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  K ^TMP("BDGICR5",$J) K BDGPRT
  1.  Q
  1.  ;
  1. EXPND ; -- expand code
  1.  Q
  1.  ;
  1. SET(DATA,NUM) ; put display line into array
  1.  S NUM=NUM+1
  1.  S ^TMP("BDGICR5",$J,NUM,0)=DATA
  1.  Q
  1.  ;
  1. PRINT ; print report to paper
  1.  NEW BDGX,BDGLN,BDGPG
  1.  U IO D INIT^BDGF    ;initialize heading variables
  1.  D HDG
  1.  ;
  1.  ; loop thru display array
  1.  S BDGX=0 F  S BDGX=$O(^TMP("BDGICR5",$J,BDGX)) Q:'BDGX  D
  1.  . I $Y>(IOSL-4) D HDG
  1.  . S BDGLN=^TMP("BDGICR5",$J,BDGX,0)
  1.  . W !,BDGLN
  1.  D ^%ZISC,PRTKL^BDGF,EXIT
  1.  Q
  1.  ;
  1. HDG ; heading for paper report
  1.  NEW X
  1.  S BDGPG=$G(BDGPG)+1 I BDGPG>1 W @IOF
  1.  W !,BDGUSR,?11,"*****",$$CONF^BDGF,"*****"
  1.  W !,BDGDATE,?25,"Completed Charts Report",?70,"Page: ",BDGPG
  1.  ;
  1.  ;IHS/OIT/LJF 04/14/2006 PATCH 1005 added observations
  1.  ;NEW X S X=$S(BDGTYP=1:"Inpatient Charts Only",BDGTYP=2:"Day Surgery Charts Only",1:"Inpatient and Day Surgery Charts")
  1.  NEW X S X=$S(BDGTYP=1:"Inpatient Charts Only",BDGTYP=2:"Day Surgery & Observation Charts",1:"Inpatient, Observaiton and Day Surgery Charts")
  1.  ;
  1.  S X=X_$$SP(4)_"-"_$$SP(4)_$P($T(CHOICE+BDGSTG),";;",2)
  1.  W !,BDGTIME,?(80-$L(X)\2),X
  1.  S X=$$RANGE^BDGF(BDGBD,BDGED) W !?(80-$L(X)\2),X   ;date range
  1.  ;
  1.  W !,$$REPEAT^XLFSTR("-",80)
  1.  S X=$S(BDGSTG=1:" Coded",BDGSTG=2:" Complt",1:" BillPrep")
  1.  W !,X,?13,"HRCN",?19,"Patient Name",?46,"Typ",?51,"Dsch/Surg"
  1.  S X=$S(BDGSTG=1:"Compl BPrep",BDGSTG=2:$$SP(6)_"BPrep",1:"")
  1.  W ?62,"WHO",?67,X
  1.  W !,$$REPEAT^XLFSTR("=",80)
  1.  Q
  1.  ;
  1. PAD(D,L) ;EP -- SUBRTN to pad length of data
  1.  ; -- D=data L=length
  1.  Q $E(D_$$REPEAT^XLFSTR(" ",L),1,L)
  1.  ;
  1. SP(N) ; -- SUBRTN to pad N number of spaces
  1.  Q $$PAD(" ",N)
  1.  ;
  1. CHOICE ;;
  1.  ;;Coded Charts;;
  1.  ;;Completed Charts;;
  1.  ;;Bill Prep Done;;