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