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

BDGICS5.m

Go to the documentation of this file. 
  1. BDGICS5 ; IHS/ANMC/LJF - INCOMPLETE STATS BY PROVIDER ;
  1.  ;;5.3;PIMS;**1005**;MAY 28, 2004
  1.  ;IHS/OIT/LJF 04/06/2006 PATCH 1005 new routine
  1.  ;
  1.  NEW BDGRPT,DEFAULT,BDGBD,BDGED,BDGSRT,BDGPRV
  1.  ;
  1.  S BDGRPT=$$READ^BDGF("S0^1:Statistics Only;2:List Charts Only;3:Both Statistics & Listing","Select Report Format") Q:BDGRPT<1
  1.  ;
  1.  S BDGBD=$$READ^BDGF("DO^::EX","Select Beginning Discharge/Surgery Date") Q:BDGBD<1
  1.  S BDGED=$$READ^BDGF("DO^::EX","Select Ending Discharge/Surgery Date") Q:BDGED<1
  1.  ;
  1.  S BDGPRV=$$READ^BDGF("YO","Print Report for ALL Providers","NO")
  1.  Q:BDGPRV=U  S:BDGPRV=1 BDGPRV="ALL"
  1.  I BDGPRV=0 S BDGPRV=$$PROVS^BDGICR2 I '$O(BDGPRV(0)) Q
  1.  ;
  1.  S BDGSRT=$$READ^BDGF("SO^1:Chart Deficiency;2:Discharge/Surgery Date","Within Provider Sort By") Q:BDGSRT<1
  1.  ;
  1.  I $$BROWSE^BDGF="B" D EN Q
  1.  D ZIS^BDGF("PQM","EN^BDGICS5","IC STATS BY PROVIDER","BDGRPT;BDGBD;BDGED;BDGSRT;BDGPRV*")
  1.  Q
  1.  ;
  1.  ;
  1. EN ; -- main entry point for BDG IC CHARTS BY PATIENT
  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 STATS BY PROVIDER")
  1.  D CLEAR^VALM1
  1.  Q
  1.  ;
  1. HDR ; -- header code
  1.  NEW X
  1.  S VALMHDR(1)=$$SP(15)_$$CONF^BDGF
  1.  S X="Sorted by "_$S(BDGSRT=1:"Chart Deficiency",1:"Discharge/Surgery Date")
  1.  S VALMHDR(2)=$$SP(75-$L(X)\2)_X
  1.  S X=$$RANGE^BDGF(BDGBD,BDGED),VALMHDR(3)=$$SP(75-$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.  K ^TMP("BDGICS5",$J),^TMP("BDGICS5A",$J)
  1.  S VALMCNT=0
  1.  ;
  1.  ; first find incomplete entries by date range & sort by patient
  1.  NEW DATE,END
  1.  S DATE=BDGBD-.0001,END=BDGED+.24
  1.  D FIND                   ;gather visits by provider
  1.  ;
  1.  ; now take sorted list and put into display array
  1.  NEW SORT,IEN,LINE,PRV,NAME,IEN2,STR,BDGCNT,FIRST
  1.  S FIRST=1
  1.  S PRV=0 F  S PRV=$O(^TMP("BDGICS5A",$J,PRV)) Q:PRV=""  D
  1.  . I FIRST S FIRST=0
  1.  . E  D SET("",.VALMCNT)
  1.  . D SET($$SP(15)_"**** "_PRV_" ****",.VALMCNT)
  1.  . K BDGCNT
  1.  . ;
  1.  . S SORT=0 F   S SORT=$O(^TMP("BDGICS5A",$J,PRV,SORT)) Q:SORT=""  D
  1.  .. S IEN=0 F  S IEN=$O(^TMP("BDGICS5A",$J,PRV,SORT,IEN)) Q:'IEN  D
  1.  ... S IEN2=0 F  S IEN2=$O(^TMP("BDGICS5A",$J,PRV,SORT,IEN,IEN2)) Q:'IEN2  D
  1.  .... S STR=^TMP("BDGICS5A",$J,PRV,SORT,IEN,IEN2)
  1.  .... ;
  1.  .... ; build display line if requested
  1.  .... I BDGRPT>1 D
  1.  ..... S LINE=$$PAD($J($$GET1^DIQ(9009016.1,IEN,.011),7),10)             ;chart #
  1.  ..... S LINE=LINE_$E($$GET1^DIQ(9009016.1,IEN,.0392),1,3)               ;service category
  1.  ..... S LINE=$$PAD(LINE,18)_$$NUMDATE^BDGF(+STR\1)                      ;dsch/surg date
  1.  ..... S LINE=$$PAD(LINE,31)_$E($P(STR,U,2),1,20)                        ;deficiency name
  1.  ..... S LINE=$$PAD(LINE,53)_$$GET1^DIQ(9009016.11,IEN2_","_IEN,.0393)   ;def status
  1.  ..... S LINE=$$PAD(LINE,66)_$$GET1^DIQ(9009016.11,IEN2_","_IEN,.0392)   ;days to complete
  1.  ..... D SET(LINE,.VALMCNT)
  1.  .... ;
  1.  .... Q:BDGRPT=2   ;no stats if requested listing only
  1.  .... ;
  1.  .... ; build statistical counts
  1.  .... NEW DELQ,RESV,X
  1.  .... S BDGCNT("TOTAL")=$G(BDGCNT("TOTAL"))+1                               ;add to incomplete count
  1.  .... S X=$$GET1^DIQ(9009016.1,IEN,.0392)                                   ;visit's service category
  1.  .... S BDGCNT("TOTAL",X)=$G(BDGCNT("TOTAL",X))+1                           ;IC count by service category
  1.  .... ;
  1.  .... I $$GET1^DIQ(9009016.4,$P(STR,U,3),.03)="ADMIN ONLY" Q                ;quit if deficiency not to be counted
  1.  .... S DELQ=$$GET1^DIQ(9009016.11,IEN2_","_IEN,.0391) Q:DELQ=""            ;date delinquent (computed)
  1.  .... S %DT="",X=DELQ D ^%DT S DELQ=Y                                       ;convert to internal format
  1.  .... S RESV=$$GET1^DIQ(9009016.11,IEN2_","_IEN,.03,"I") S:'RESV RESV=DT    ;date resolved
  1.  .... I (DELQ<RESV) D
  1.  ..... S BDGCNT("DELQ")=$G(BDGCNT("DELQ"))+1                                ;add to delinquent count
  1.  ..... S BDGCNT("DELQ",$P(STR,U,2))=$G(BDGCNT("DELQ",$P(STR,U,2)))+1        ;DQ counts by deficiency
  1.  . ;
  1.  . Q:BDGRPT=2    ;don't display if requested listing only
  1.  . ; now display provider's statistics
  1.  . D SET("",.VALMCNT)
  1.  . D SET($$PAD("TOTAL INCOMPLETE CHARTS",30)_(+$G(BDGCNT("TOTAL"))),.VALMCNT)
  1.  . I $G(BDGCNT("TOTAL")) D
  1.  .. S X=0 F  S X=$O(BDGCNT("TOTAL",X)) Q:X=""  D SET($$PAD($$SP(7)_"Incomplete "_X_" Charts",45)_BDGCNT("TOTAL",X),.VALMCNT)
  1.  .. D SET("",.VALMCNT)
  1.  .. D SET($$PAD("# OF DELINQUENT CHARTS",30)_(+$G(BDGCNT("DELQ"))),.VALMCNT)
  1.  .. S X=0 F  S X=$O(BDGCNT("DELQ",X)) Q:X=""  D SET($$PAD($$SP(7)_"Delinquent for "_X,45)_BDGCNT("DELQ",X),.VALMCNT)
  1.  ;
  1.  I '$D(^TMP("BDGICS5",$J)) D SET("NO DATA FOUND",.VALMCNT)
  1.  K ^TMP("BDGICS5A",$J)
  1.  Q
  1.  ;
  1. FIND ; find all entries for date range
  1.  NEW SUB,DATE,END,IEN,SORT,IEN2,PROV,DEF,DEF1
  1.  F SUB="AD","AS" D
  1.  . S DATE=BDGBD-.0001,END=BDGED+.24
  1.  . F  S DATE=$O(^BDGIC(SUB,DATE)) Q:'DATE  Q:(DATE>END)  D
  1.  .. S IEN=0 F  S IEN=$O(^BDGIC(SUB,DATE,IEN)) Q:'IEN  D
  1.  ... ;
  1.  ... I $$GET1^DIQ(9009016.1,IEN,.14)]"" Q         ;quit if deleted
  1.  ... I BDGSRT=2 S X=$$GET1^DIQ(9009016.1,IEN,.02,"I"),SORT=$S(X]"":X,1:$$GET1^DIQ(9009016.1,IEN,.05,"I"))
  1.  ... ;
  1.  ... ; find all providers with deficiencies
  1.  ... S IEN2=0 F  S IEN2=$O(^BDGIC(IEN,1,IEN2)) Q:'IEN2  D
  1.  .... Q:$$GET1^DIQ(9009016.11,IEN2_","_IEN,.04)]""               ;don't count if deleted
  1.  .... ;
  1.  .... S PROV=$$GET1^DIQ(9009016.11,IEN2_","_IEN,.01,"I")               ;provider pointer
  1.  .... I BDGPRV="SRV",'$D(BDGPRV(+$$GET1^DIQ(200,PROV,29,"I"))) Q       ;skip if prov not in requested service
  1.  .... I BDGPRV="CLASS",'$D(BDGPRV(+$$GET1^DIQ(200,PROV,53.5,"I"))) Q   ;skip if prov not in requested class
  1.  .... I BDGPRV="NAME",'$D(BDGPRV(PROV)) Q                              ;skip if provider not requested by name
  1.  .... ;
  1.  .... S PROV=$$GET1^DIQ(9009016.11,IEN2_","_IEN,.01)           ;provider name
  1.  .... S DEF=$$GET1^DIQ(9009016.11,IEN2_","_IEN,.02)            ;deficiency name
  1.  .... S DEFI=$$GET1^DIQ(9009016.11,IEN2_","_IEN,.02,"I")       ;deficiency pointer
  1.  .... I BDGSRT=1 S SORT=DEF
  1.  .... S ^TMP("BDGICS5A",$J,PROV,SORT,IEN,IEN2)=DATE_U_DEF_U_DEFI        ;put into sorted list
  1.  Q
  1.  ;
  1. SET(DATA,NUM) ; puts display line into list template array
  1.  S NUM=NUM+1
  1.  S ^TMP("BDGICS5",$J,NUM,0)=DATA
  1.  Q
  1.  ;
  1. HELP ; -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  K ^TMP("BDGICS5",$J) K BDGPRT
  1.  Q
  1.  ;
  1. EXPND ; -- expand code
  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("BDGICS5",$J,BDGX)) Q:'BDGX  D
  1.  . I $Y>(IOSL-4) D HDG
  1.  . S BDGLN=^TMP("BDGICS5",$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,?23,"Incomplete Statistics by Provider",?70,"Page: ",BDGPG
  1.  S X="Sorted by "_$S(BDGSRT=1:"Chart Deficiency",1:"Discharge/Surgery Date")
  1.  W !,BDGTIME,?(80-$L(X)\2),X
  1.  S X=$$RANGE^BDGF(BDGBD,BDGED) W !,?(80-$L(X)\2),X
  1.  W !,$$REPEAT^XLFSTR("-",80)
  1.  I BDGRPT>1 D
  1.  . W !?2,"Chart#",?10,"Type",?18,"Dsch/Surg",?31,"Deficiency",?53,"Status",?63,"Days to Complete"
  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.  ;