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

BDGICS3.m

Go to the documentation of this file. 
  1. BDGICS3 ; IHS/OIT/LJF - OBSERVATIONS 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 new routine
  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^BDGICS3","OBSERVATION CODING STATUS","BDGBM;BDGEM")
  1.  Q
  1.  ;
  1.  ;
  1. EN ;EP; -- 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 OBS")
  1.  D CLEAR^VALM1
  1.  Q
  1.  ;
  1. HDR ;EP; -- 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 ;EP; -- 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("BDGICS3",$J),^TMP("BDGICS3A",$J)
  1.  S VALMCNT=0
  1.  ;
  1.  ; loop through observation 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:$$GET1^DIQ(9000010,VST,.07)'="OBSERVATION"
  1.  .. Q:$$GET1^DIQ(9000010,VST,.11)="DELETED"
  1.  .. Q:$$GET1^DIQ(9000010,VST,.06,"I")'=DUZ(2)  ;visit from different facility
  1.  .. ;
  1.  .. ;increment # observations per month
  1.  .. S COUNT(MONTH,"OBS")=$G(COUNT(MONTH,"OBS"))+1
  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.  .. ;
  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
  1.  ;
  1.  ; build display array
  1.  ;    monthly counts heading
  1.  S LINE=$$PAD($$PAD("Month/Year",13)_"# Obsrv Vsts",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="OBS","COD","UNC","EXP","ERR" D
  1.  .. S LINE=LINE_$J(+$G(COUNT(MON,SUB)),4)_$$SP(8)
  1.  . D SET(LINE,.VALMCNT)
  1.  ;
  1.  ;add totals for each column
  1.  D SET($$REPEAT^XLFSTR("=",79),.VALMCNT)
  1.  S LINE=$$SP(15)
  1.  F SUB="OBS","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("BDGICS3A",$J,"U")) D
  1.  . S LINE=$$PAD($$PAD("Visit 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("BDGICS3A",$J,"U",DATE)) Q:'DATE  D
  1.  . S VST=0 F  S VST=$O(^TMP("BDGICS3A",$J,"U",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),15)               ;admit 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.  .. ;
  1.  .. S ADM=$O(^DGPM("AVISIT",VST,0))
  1.  .. I ADM S LINE=LINE_$E($$ADMSRV^BDGF1(ADM,DFN),1,3)     ;service
  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("BDGICS3A",$J,"E")) D
  1.  . I $E(IOST,1,2)="P-" D SET("@@@",.VALMCNT)   ;mark errors for paper
  1.  . S LINE=$$PAD("Visit 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("BDGICS3A",$J,"E",DATE)) Q:'DATE  D
  1.  . S VST=0 F  S VST=$O(^TMP("BDGICS3A",$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)                  ;admit 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("BDGICS3A",$J,"E",DATE,VST)   ;err msg
  1.  .. D SET(LINE,.VALMCNT)
  1.  ;
  1.  I '$D(^TMP("BDGICS3",$J)) D SET("NO DATA FOUND",.VALMCNT)
  1.  K ^TMP("BDGICS3A",$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("BDGICS3A",$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("BDGICS3A",$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("BDGICS3",$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("BDGICS3",$J,BDGL)) Q:'BDGL  D
  1.  . I ^TMP("BDGICS3",$J,BDGL,0)="@@@" S FIRST=1 Q  ;beginning of errors
  1.  . I $Y>(IOSL-4) D HDG
  1.  . W !,^TMP("BDGICS3",$J,BDGL,0)
  1.  D ^%ZISC,EXIT
  1.  Q
  1.  ;
  1. HDG ; heading when printing to paper
  1.  W @IOF W !?25,"OBSERVATIONS 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 !,"Visit 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("BDGICS3",$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)