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

BDGICS2.m

Go to the documentation of this file. 
  1. BDGICS2 ; IHS/ANMC/LJF - DAY SURGERY CODING STATUS ;  [ 04/08/2004  4:02 PM ]
  1.  ;;5.3;PIMS;**1005,1010**;MAY 28, 2004
  1.  ;IHS/OIT/LJF 02/16/2006 PATCH 1005 fixed logic for determining if uncoded
  1.  ;cmi/anch/maw 10/20/2008 PATCH 1010 changed export date field from .14 to 1106
  1.  ;
  1.  NEW BDGBM,BDGEM
  1.  S BDGBM=$$READ^BDGF("DO^::EP","Select Beginning Month") Q:BDGBM<1
  1.  S BDGEM=$$READ^BDGF("DO^::EP","Select Ending Month") Q:BDGEM<1
  1.  S BDGBM=$E(BDGBM,1,5)_"00",BDGEM=$E(BDGEM,1,5)_"31.24"
  1.  ;
  1.  D ZIS^BDGF("PQ","EN^BDGICS2","DS CODING STATUS","BDGBM;BDGEM")
  1.  Q
  1.  ;
  1.  ;
  1. EN ; -- main entry point for BDG IC CODE STATUS DS
  1.  NEW VALMCNT
  1.  I $E(IOST,1,2)="P-" S BDGPRT=1 D INIT,PRINT Q   ;if printing to paper
  1.  D TERM^VALM0,CLEAR^VALM1
  1.  D EN^VALM("BDG IC CODE STATUS DS")
  1.  D CLEAR^VALM1
  1.  Q
  1.  ;
  1. HDR ; -- header code
  1.  NEW X
  1.  S VALMHDR(1)=$$SP(20)_$$CONF^BDGF
  1.  S X=$$GET1^DIQ(4,DUZ(2),.01),VALMHDR(2)=$$SP(79-$L(X)\2)_X
  1.  S X=$$RANGE^BDGF(BDGBM,(BDGEM\1))
  1.  S VALMHDR(3)=$$SP(79-$L(X)\2)_X
  1.  Q
  1.  ;
  1. INIT ; -- init variables and list array
  1.  I '$G(BDGPRT) D MSG^BDGF("Please wait while I compile the list...",2,0)
  1.  NEW DATE,TODAY,DFN,IEN,COUNT,VST,VH,MONTH,SUB,ADM,X,LINE,DSC,Y
  1.  K ^TMP("BDGICS2",$J),^TMP("BDGICS2A",$J)
  1.  S VALMCNT=0
  1.  ;
  1.  ; loop through day surgery visits for date range
  1.  S DATE=BDGBM,TODAY=DT+.24
  1.  F  S DATE=$O(^AUPNVSIT("B",DATE)) Q:('DATE)!(DATE>BDGEM)!(DATE>TODAY)  D
  1.  . S MONTH=$E(DATE,1,5)
  1.  . S VST=0 F  S VST=$O(^AUPNVSIT("B",DATE,VST)) Q:'VST  D
  1.  .. ;
  1.  .. Q:$P(^AUPNVSIT(VST,0),U,7)'="S"     ;day surgery visits only
  1.  .. Q:$P(^AUPNVSIT(VST,0),U,11)=1       ;deleted
  1.  .. Q:$P(^AUPNVSIT(VST,0),U,6)'=DUZ(2)  ;different location
  1.  .. ;
  1.  .. ;increment # day surgeries per month
  1.  .. S COUNT(MONTH,"DS")=$G(COUNT(MONTH,"DS"))+1
  1.  .. ;
  1.  .. ; check for errors if running VA Surgery
  1.  .. I $O(^SRF("ADS",0)) D
  1.  ... S SRN=$O(^SRF("ADS",VST,0))
  1.  ... I 'SRN D ERR("NO Surgery entry for visit",VST,DATE) Q
  1.  ... I $$GET1^DIQ(130,SRN,.011,"I")'["DS" D ERR("Visit linked to "_$$GET1^DIQ(130,SRN,.011),VST,DATE) Q
  1.  ... S SRRS=$$GET1^DIQ(130,SRN,9999999.06,"I")  ;ds release status
  1.  ... I SRRS="AD" D ERR("Surgery says unplanned admit",VST,DATE) Q
  1.  ... I (SRRS="NS")!(SRRS="CA") D ERR("Surgery says "_$S(SRRS="NS":"No-show",1:"Cancelled"),VST,DATE) Q
  1.  .. ;
  1.  .. ; check if uncoded
  1.  .. S X=$O(^AUPNVPOV("AD",VST,0)),Y=$O(^AUPNVPRV("AD",VST,0))
  1.  .. ;I (X=""),(Y="") D UNCODED(DATE,VST) Q
  1.  .. I (X="")!(Y="") D UNCODED(DATE,VST) Q   ;IHS/OIT/LJF 02/16/2006 PATCH 1005
  1.  .. ;
  1.  .. ; check if exported
  1.  .. S COUNT(MONTH,"COD")=$G(COUNT(MONTH,"COD"))+1
  1.  .. ;I $$GET1^DIQ(9000010,VST,.14)]"" S COUNT(MONTH,"EXP")=$G(COUNT(MONTH,"EXP"))+1  ;cmi/maw 10/20/2008 PATCH 1010 orig line
  1.  .. I $$GET1^DIQ(9000010,VST,1106)]"" S COUNT(MONTH,"EXP")=$G(COUNT(MONTH,"EXP"))+1  ;cmi/maw 10/20/2008 PATCH 1010 new export date field
  1.  ;
  1.  ; build display array
  1.  ;    monthly counts heading
  1.  S LINE=$$PAD($$PAD("Month/Year",13)_"# Surgeries",26)
  1.  S LINE=$$PAD(LINE_"# Coded",36)
  1.  S LINE=$$PAD($$PAD(LINE_"# Not-Coded",50)_"# Exported",62)
  1.  S LINE=LINE_"# Errors" D SET(LINE,.VALMCNT)
  1.  ;    monthly counts
  1.  S MON=0 F  S MON=$O(COUNT(MON)) Q:'MON  D
  1.  . S LINE=$$PAD($$FMTE^XLFDT(MON_"00"),15)
  1.  . F SUB="DS","COD","UNC","EXP","ERR" D
  1.  .. S LINE=LINE_$J(+$G(COUNT(MON,SUB)),4)_$$SP(8)
  1.  . D SET(LINE,.VALMCNT)
  1.  ;
  1.  D SET($$REPEAT^XLFSTR("=",79),.VALMCNT)
  1.  S LINE=$$SP(15)
  1.  F SUB="DS","COD","UNC","EXP","ERR" D
  1.  . S TOTAL=0,MON=0
  1.  . F  S MON=$O(COUNT(MON)) Q:'MON  S TOTAL=$G(TOTAL)+$G(COUNT(MON,SUB))
  1.  . S LINE=LINE_$J(TOTAL,4)_$$SP(8)
  1.  D SET(LINE,.VALMCNT)
  1.  D SET("",.VALMCNT)
  1.  ;
  1.  ; list uncoded charts
  1.  ;   if any uncoded charts, print heading
  1.  I $D(^TMP("BDGICS2A",$J,"U")) D
  1.  . S LINE=$$PAD($$PAD("Surgery Date",15)_"Patient Name",45)
  1.  . S LINE=$$PAD(LINE_"Chart #",58)_"Srv"
  1.  . S LINE=$$PAD(LINE,64)_"Insurance"
  1.  . D SET("",.VALMCNT),SET(LINE,.VALMCNT)
  1.  ;
  1.  S DATE=0 F  S DATE=$O(^TMP("BDGICS2A",$J,"U",DATE)) Q:'DATE  D
  1.  . S VST=0 F  S VST=$O(^TMP("BDGICS2A",$J,"U",DATE,VST)) Q:'VST  D
  1.  .. ;
  1.  .. S SRN=+$O(^SRF("ADS",VST,0))                          ;surgery entry
  1.  .. S DFN=$$GET1^DIQ(9000010,VST,.05,"I")                 ;pat ien
  1.  .. ;
  1.  .. S LINE=$$PAD($$NUMDATE^BDGF(DATE\1),15)               ;surgery date
  1.  .. S LINE=$$PAD(LINE_$E($$GET1^DIQ(2,DFN,.01),1,22),45)  ;name
  1.  .. S LINE=$$PAD(LINE_$J($$HRCN^BDGF2(DFN,DUZ(2)),6),58)
  1.  .. S LINE=LINE_$E($$GET1^DIQ(130,SRN,.04),1,3)           ;sur specialty
  1.  .. ;
  1.  .. ; add insurance coverage
  1.  .. S LINE=$$PAD(LINE,64)_$$INSUR^BDGF2(DFN,DATE)
  1.  .. D SET(LINE,.VALMCNT)
  1.  ;
  1.  ; add error charts to display listing
  1.  ;     if any errors, print heading
  1.  I $D(^TMP("BDGICS2A",$J,"E")) D
  1.  . I $E(IOST,1,2)="P-" D SET("@@@",.VALMCNT)   ;mark errors for paper
  1.  . S LINE=$$PAD("Surgery Date",16)_"Patient Name"
  1.  . S LINE=$$PAD($$PAD(LINE,38)_"Chart #",48)_"Error Message"
  1.  . D SET("",.VALMCNT),SET(LINE,.VALMCNT)
  1.  ;
  1.  S DATE=0 F  S DATE=$O(^TMP("BDGICS2A",$J,"E",DATE)) Q:'DATE  D
  1.  . S VST=0 F  S VST=$O(^TMP("BDGICS2A",$J,"E",DATE,VST)) Q:'VST  D
  1.  .. ;
  1.  .. S DFN=$$GET1^DIQ(9000010,VST,.05,"I")                    ;pat ien
  1.  .. S LINE=$$PAD($$NUMDATE^BDGF(DATE\1),16)                  ;sur date
  1.  .. S LINE=$$PAD(LINE_$E($$GET1^DIQ(2,DFN,.01),1,18),38)     ;name
  1.  .. S LINE=LINE_$J($$HRCN^BDGF2(DFN,DUZ(2)),6)               ;chart #
  1.  .. S LINE=$$PAD(LINE,48)_^TMP("BDGICS2A",$J,"E",DATE,VST)   ;err msg
  1.  .. D SET(LINE,.VALMCNT)
  1.  ;
  1.  I '$D(^TMP("BDGICS2",$J)) D SET("NO DATA FOUND",.VALMCNT)
  1.  K ^TMP("BDGICS2A",$J)
  1.  Q
  1.  ;
  1. ERR(MSG,VST,DATE) ; increment error count and save for listing
  1.  NEW MON
  1.  S MON=$E(DATE,1,5)
  1.  S COUNT(MON,"ERR")=$G(COUNT(MON,"ERR"))+1
  1.  S ^TMP("BDGICS2A",$J,"E",DATE,VST)=MSG
  1.  Q
  1.  ;
  1. UNCODED(DATE,VST) ; save uncoded visits by discharge date
  1.  NEW MON
  1.  S MON=$E(DATE,1,5)
  1.  S COUNT(MON,"UNC")=$G(COUNT(MON,"UNC"))+1
  1.  S ^TMP("BDGICS2A",$J,"U",DATE,VST)=""
  1.  Q
  1.  ;
  1. SET(DATA,NUM) ; put data line into display array
  1.  S NUM=NUM+1
  1.  S ^TMP("BDGICS2",$J,NUM,0)=DATA
  1.  Q
  1.  ;
  1. PRINT ; print report to paper
  1.  NEW BDGL,FIRST
  1.  U IO S FIRST=1 D HDG
  1.  S BDGL=0 F  S BDGL=$O(^TMP("BDGICS2",$J,BDGL)) Q:'BDGL  D
  1.  . I ^TMP("BDGICS2",$J,BDGL,0)="@@@" S FIRST=1 Q  ;beginning of errors
  1.  . I $Y>(IOSL-4) D HDG
  1.  . W !,^TMP("BDGICS2",$J,BDGL,0)
  1.  D ^%ZISC,EXIT
  1.  Q
  1.  ;
  1. HDG ; heading when printing to paper
  1.  W @IOF W !?20,"DAY SURGERY CODING STATUS REPORT"
  1.  D HDR F I=1:1 Q:'$D(VALMHDR(I))  W !,VALMHDR(I)
  1.  I FIRST W !,$$REPEAT^XLFSTR("=",80),! S FIRST=0 Q
  1.  W !,"Surgery Date",?24,"Patient Name",?44,"Chart #"
  1.  W !?54,"Serv",?60,"Insurance",!,$$REPEAT^XLFSTR("=",80),!
  1.  Q
  1.  ;
  1. HELP ; -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  K ^TMP("BDGICS2",$J) K BDGPRT
  1.  Q
  1.  ;
  1. EXPND ; -- expand code
  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)