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

BDGICF21.m

Go to the documentation of this file. 
  1. BDGICF21 ; IHS/ANMC/LJF - VIEW IC SUMMARY ;  [ 08/20/2004  11:45 AM ]
  1.  ;;5.3;PIMS;**1001**;APR 26, 2002
  1.  ;
  1. EN ; -- main entry point for BDG IC VIEW
  1.  NEW VALMCNT
  1.  I $E(IOST,1,2)="P-" D INIT,PRINT Q
  1.  D TERM^VALM0,CLEAR^VALM1
  1.  D EN^VALM("BDG IC VIEW")
  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=$E($$GET1^DIQ(9009016.1,BDGN,.01),1,25)               ;pat name
  1.  S X=$$PAD(X,30)_"#"_$$GET1^DIQ(9009016.1,BDGN,.011)       ;chart #
  1.  S X=$$PAD(X,40)_"Coverage: "_$$GET1^DIQ(9009016.1,BDGN,.0391)
  1.  S VALMHDR(2)=X
  1.  Q
  1.  ;
  1. INIT ; -- init variables and list array
  1.  NEW DFN,LINE,X,TYP
  1.  K ^TMP("BDGICF2",$J)
  1.  S VALMCNT=0
  1.  ;
  1.  S X="INCOMPLETE "_$$GET1^DIQ(9009016.1,BDGN,.0392)_" CHART"
  1.  ;6/19/2002 LJF8 (per Linda) Bold,RevVid,Underline,etc.
  1.  ;S LINE=$$SP(79-$L(X)\2)_IORVON_X_IORVOFF     ;center visit type
  1.  S LINE=$$SP(79-$L(X)\2)_$G(IORVON)_X_$G(IORVOFF)     ;center visit type
  1.  D SET(LINE,.VALMCNT),SET("",.VALMCNT)
  1.  ;
  1.  ; set up display of fields based on visit type
  1.  S TYP=$E($$GET1^DIQ(9009016.1,BDGN,.0392),1,3) Q:TYP=""
  1.  I (TYP="HOS")!(TYP="DAY")!(TYP="OBS") D @TYP I 1
  1.  E  D SET("???",.VALMCNT) Q
  1.  D SET("",.VALMCNT)
  1.  D DATES(TYP)                  ;date fields
  1.  D SET("",.VALMCNT)
  1.  D DATA(.18,21)                ;additional comments
  1.  D DEF                         ;display deficiencies with resolutions
  1.  ;
  1.  Q
  1.  ;
  1. HOS ; process admission fields
  1.  NEW FIELD
  1.  F FIELD=.03,.02,.04 D DATA(FIELD,25)
  1.  Q
  1.  ;
  1. DAY ; process day surgery fields
  1.  NEW FIELD
  1.  F FIELD=.03,.05,.04 D DATA(FIELD,25)
  1.  Q
  1.  ;
  1. OBS ; process observation fields     
  1.  D DAY Q
  1.  ;
  1. DATA(FLD,LEN) ; process one field
  1.  NEW X,LINE
  1.  S X=$$GET1^DIQ(9009016.1,BDGN,FLD) I X="" Q
  1.  S LINE=$$RJ^XLFSTR($$TITLE(FLD),LEN)_X
  1.  I FLD=.13 S LINE=LINE_" by "_$$GET1^DIQ(9009016.1,BDGN,.22)  ;coder
  1.  I FLD=.15 S LINE=LINE_" by "_$$GET1^DIQ(9009016.1,BDGN,.23)  ;bill pre
  1.  D SET(LINE,.VALMCNT)
  1.  Q
  1.  ;
  1. DEF ; find deficiencies to display
  1.  NEW IEN,PRV,FIRST,LINE,X
  1.  ; loop by provider name
  1.  S FIRST=1
  1.  S PRV=0 F  S PRV=$O(^BDGIC(BDGN,1,"B",PRV)) Q:'PRV  D
  1.  . S IEN=0 F  S IEN=$O(^BDGIC(BDGN,1,"B",PRV,IEN)) Q:'IEN  D
  1.  .. ;
  1.  .. ; quit if deleted deficiency and only displaying pending ones
  1.  .. I '$G(BDGIC),$$GET1^DIQ(9009016.11,IEN_","_BDGN,.04)]"" Q
  1.  .. ;
  1.  .. ; quit if resolved deficiency and only displaying pending ones
  1.  .. I '$G(BDGIC),$$GET1^DIQ(9009016.11,IEN_","_BDGN,.03)]"" Q
  1.  .. ;
  1.  .. I FIRST D SET($$SP(3)_"Deficiencies:",.VALMCNT) S FIRST=0
  1.  .. ;
  1.  .. S LINE=$$PAD($$SP(5)_$E($$GET1^DIQ(200,+PRV,.01),1,20),30)  ;name
  1.  .. S LINE=LINE_$$GET1^DIQ(9009016.11,IEN_","_BDGN,.02)  ;deficiency
  1.  .. S LINE=$$PAD(LINE,60)_$$GET1^DIQ(9009016.11,IEN_","_BDGN,.0393)
  1.  .. D SET(LINE,.VALMCNT)
  1.  .. ;
  1.  .. ; if resolved, give date and how long it took
  1.  .. S X=$$GET1^DIQ(9009016.11,IEN_","_BDGN,.03) I X]"" D
  1.  ... S LINE=$$SP(7)_"Resolved on "_X_" in "
  1.  ... S LINE=LINE_$$GET1^DIQ(9009016.11,IEN_","_BDGN,.0392)_" days"
  1.  ... D SET(LINE,.VALMCNT)
  1.  .. ;
  1.  .. ; if deleted, give date and reason
  1.  .. S X=$$GET1^DIQ(9009016.11,IEN_","_BDGN,.04) I X]"" D
  1.  ... S LINE=$$SP(7)_" Deleted on "_X_"; Reason: "
  1.  ... S LINE=LINE_$$GET1^DIQ(9009016.11,IEN_","_BDGN,.05)
  1.  ... D SET(LINE,.VALMCNT)
  1.  .. ;
  1.  .. ; display comment if one exists
  1.  .. S X=$$GET1^DIQ(9009016.11,IEN_","_BDGN,.06) I X]"" D
  1.  ... D SET($$SP(7)_"Comment: "_X,.VALMCNT)
  1.  Q
  1.  ;
  1. SET(DATA,NUM) ; put display data into array
  1.  S NUM=NUM+1
  1.  S ^TMP("BDGICF2",$J,NUM,0)=DATA
  1.  Q
  1.  ;
  1. TITLE(F) ;  return field F name or title
  1.  NEW X S X=$G(^DD(9009016.1,F,.1))
  1.  Q $S(X]"":X,1:$P(^DD(9009016.1,F,0),U))_":  "
  1.  ;
  1. DATES(TYP) ; set up travel fields for display
  1.  NEW FIELD
  1.  D DATA($S(TYP["DAY":.05,1:.02),30)
  1.  F FIELD=.11,.19,.12,.13,.14,.15,.16 D DATA(FIELD,30)
  1.  D SET("",.VALMCNT),DATA(.21,30)
  1.  Q
  1.  ;
  1. HELP ; -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  K ^TMP("BDGICF2",$J)
  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)
  1.  ;
  1. PRINT ; print report to paper
  1.  NEW BDGX
  1.  ;IHS/ITSC/LJF 6/2/2004;PATCH #1001
  1.  ;U IO D HDR
  1.  U IO D HDG
  1.  ;
  1.  ; loop thru display array
  1.  S BDGX=0 F  S BDGX=$O(^TMP("BDGICF2",$J,BDGX)) Q:'BDGX  D
  1.  . I $Y>(IOSL-4) D HDG
  1.  . W !,^TMP("BDGICF2",$J,BDGX,0)
  1.  D ^%ZISC,EXIT
  1.  Q
  1.  ;
  1. HDG ; heading for paper report
  1.  ;IHS/ITSC/LJF 6/2/2004;PATCH #1001
  1.  ;D HDR W @IOF,?15,"Scheduled Visit Summary"
  1.  D HDR W @IOF,?15,"Incomplete Chart Summary"
  1.  F I=1:1 Q:'$D(VALMHDR(I))  W !,VALMHDR(I)
  1.  W !,$$REPEAT^XLFSTR("=",80)
  1.  Q
  1.  ;