BDGICS3 ; IHS/OIT/LJF - OBSERVATIONS CODING STATUS ; [ 04/08/2004 4:02 PM ]
;;5.3;PIMS;**1005,1010**;MAY 28, 2004
;IHS/OIT/LJF 02/16/2006 PATCH 1005 new routine
;cmi/anch/maw 10/20/2008 PATCH 1010 changed export date field from .14 to 1106
;
NEW BDGBM,BDGEM
S BDGBM=$$READ^BDGF("DO^::EP","Select Beginning Month") Q:BDGBM<1
S BDGEM=$$READ^BDGF("DO^::EP","Select Ending Month") Q:BDGEM<1
S BDGBM=$E(BDGBM,1,5)_"00",BDGEM=$E(BDGEM,1,5)_"31.24"
;
D ZIS^BDGF("PQ","EN^BDGICS3","OBSERVATION CODING STATUS","BDGBM;BDGEM")
Q
;
;
EN ;EP; -- main entry point for BDG IC CODE STATUS DS
NEW VALMCNT
I $E(IOST,1,2)="P-" S BDGPRT=1 D INIT,PRINT Q ;if printing to paper
D TERM^VALM0,CLEAR^VALM1
D EN^VALM("BDG IC CODE STATUS OBS")
D CLEAR^VALM1
Q
;
HDR ;EP; -- header code
NEW X
S VALMHDR(1)=$$SP(20)_$$CONF^BDGF
S X=$$GET1^DIQ(4,DUZ(2),.01),VALMHDR(2)=$$SP(79-$L(X)\2)_X
S X=$$RANGE^BDGF(BDGBM,(BDGEM\1))
S VALMHDR(3)=$$SP(79-$L(X)\2)_X
Q
;
INIT ;EP; -- init variables and list array
I '$G(BDGPRT) D MSG^BDGF("Please wait while I compile the list...",2,0)
NEW DATE,TODAY,DFN,IEN,COUNT,VST,VH,MONTH,SUB,ADM,X,LINE,DSC,Y
K ^TMP("BDGICS3",$J),^TMP("BDGICS3A",$J)
S VALMCNT=0
;
; loop through observation visits for date range
S DATE=BDGBM,TODAY=DT+.24
F S DATE=$O(^AUPNVSIT("B",DATE)) Q:('DATE)!(DATE>BDGEM)!(DATE>TODAY) D
. S MONTH=$E(DATE,1,5)
. S VST=0 F S VST=$O(^AUPNVSIT("B",DATE,VST)) Q:'VST D
.. ;
.. Q:$$GET1^DIQ(9000010,VST,.07)'="OBSERVATION"
.. Q:$$GET1^DIQ(9000010,VST,.11)="DELETED"
.. Q:$$GET1^DIQ(9000010,VST,.06,"I")'=DUZ(2) ;visit from different facility
.. ;
.. ;increment # observations per month
.. S COUNT(MONTH,"OBS")=$G(COUNT(MONTH,"OBS"))+1
.. ;
.. ; check if uncoded
.. S X=$O(^AUPNVPOV("AD",VST,0)),Y=$O(^AUPNVPRV("AD",VST,0))
.. I (X="")!(Y="") D UNCODED(DATE,VST) Q
.. ;
.. ; check if exported
.. S COUNT(MONTH,"COD")=$G(COUNT(MONTH,"COD"))+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
.. 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
;
; build display array
; monthly counts heading
S LINE=$$PAD($$PAD("Month/Year",13)_"# Obsrv Vsts",26)
S LINE=$$PAD(LINE_"# Coded",36)
S LINE=$$PAD($$PAD(LINE_"# Not-Coded",50)_"# Exported",62)
S LINE=LINE_"# Errors" D SET(LINE,.VALMCNT)
; monthly counts
S MON=0 F S MON=$O(COUNT(MON)) Q:'MON D
. S LINE=$$PAD($$FMTE^XLFDT(MON_"00"),15)
. F SUB="OBS","COD","UNC","EXP","ERR" D
.. S LINE=LINE_$J(+$G(COUNT(MON,SUB)),4)_$$SP(8)
. D SET(LINE,.VALMCNT)
;
;add totals for each column
D SET($$REPEAT^XLFSTR("=",79),.VALMCNT)
S LINE=$$SP(15)
F SUB="OBS","COD","UNC","EXP","ERR" D
. S TOTAL=0,MON=0
. F S MON=$O(COUNT(MON)) Q:'MON S TOTAL=$G(TOTAL)+$G(COUNT(MON,SUB))
. S LINE=LINE_$J(TOTAL,4)_$$SP(8)
D SET(LINE,.VALMCNT)
D SET("",.VALMCNT)
;
; list uncoded charts
; if any uncoded charts, print heading
I $D(^TMP("BDGICS3A",$J,"U")) D
. S LINE=$$PAD($$PAD("Visit Date",15)_"Patient Name",45)
. S LINE=$$PAD(LINE_"Chart #",58)_"Srv"
. S LINE=$$PAD(LINE,64)_"Insurance"
. D SET("",.VALMCNT),SET(LINE,.VALMCNT)
;
S DATE=0 F S DATE=$O(^TMP("BDGICS3A",$J,"U",DATE)) Q:'DATE D
. S VST=0 F S VST=$O(^TMP("BDGICS3A",$J,"U",DATE,VST)) Q:'VST D
.. ;
.. S DFN=$$GET1^DIQ(9000010,VST,.05,"I") ;pat ien
.. S LINE=$$PAD($$NUMDATE^BDGF(DATE\1),15) ;admit date
.. S LINE=$$PAD(LINE_$E($$GET1^DIQ(2,DFN,.01),1,22),45) ;name
.. S LINE=$$PAD(LINE_$J($$HRCN^BDGF2(DFN,DUZ(2)),6),58)
.. ;
.. S ADM=$O(^DGPM("AVISIT",VST,0))
.. I ADM S LINE=LINE_$E($$ADMSRV^BDGF1(ADM,DFN),1,3) ;service
.. ;
.. ; add insurance coverage
.. S LINE=$$PAD(LINE,64)_$$INSUR^BDGF2(DFN,DATE)
.. D SET(LINE,.VALMCNT)
;
; add error charts to display listing
; if any errors, print heading
I $D(^TMP("BDGICS3A",$J,"E")) D
. I $E(IOST,1,2)="P-" D SET("@@@",.VALMCNT) ;mark errors for paper
. S LINE=$$PAD("Visit Date",16)_"Patient Name"
. S LINE=$$PAD($$PAD(LINE,38)_"Chart #",48)_"Error Message"
. D SET("",.VALMCNT),SET(LINE,.VALMCNT)
;
S DATE=0 F S DATE=$O(^TMP("BDGICS3A",$J,"E",DATE)) Q:'DATE D
. S VST=0 F S VST=$O(^TMP("BDGICS3A",$J,"E",DATE,VST)) Q:'VST D
.. ;
.. S DFN=$$GET1^DIQ(9000010,VST,.05,"I") ;pat ien
.. S LINE=$$PAD($$NUMDATE^BDGF(DATE\1),16) ;admit date
.. S LINE=$$PAD(LINE_$E($$GET1^DIQ(2,DFN,.01),1,18),38) ;name
.. S LINE=LINE_$J($$HRCN^BDGF2(DFN,DUZ(2)),6) ;chart #
.. S LINE=$$PAD(LINE,48)_^TMP("BDGICS3A",$J,"E",DATE,VST) ;err msg
.. D SET(LINE,.VALMCNT)
;
I '$D(^TMP("BDGICS3",$J)) D SET("NO DATA FOUND",.VALMCNT)
K ^TMP("BDGICS3A",$J)
Q
;
ERR(MSG,VST,DATE) ; increment error count and save for listing
NEW MON
S MON=$E(DATE,1,5)
S COUNT(MON,"ERR")=$G(COUNT(MON,"ERR"))+1
S ^TMP("BDGICS3A",$J,"E",DATE,VST)=MSG
Q
;
UNCODED(DATE,VST) ; save uncoded visits by discharge date
NEW MON
S MON=$E(DATE,1,5)
S COUNT(MON,"UNC")=$G(COUNT(MON,"UNC"))+1
S ^TMP("BDGICS3A",$J,"U",DATE,VST)=""
Q
;
SET(DATA,NUM) ; put data line into display array
S NUM=NUM+1
S ^TMP("BDGICS3",$J,NUM,0)=DATA
Q
;
PRINT ; print report to paper
NEW BDGL,FIRST
U IO S FIRST=1 D HDG
S BDGL=0 F S BDGL=$O(^TMP("BDGICS3",$J,BDGL)) Q:'BDGL D
. I ^TMP("BDGICS3",$J,BDGL,0)="@@@" S FIRST=1 Q ;beginning of errors
. I $Y>(IOSL-4) D HDG
. W !,^TMP("BDGICS3",$J,BDGL,0)
D ^%ZISC,EXIT
Q
;
HDG ; heading when printing to paper
W @IOF W !?25,"OBSERVATIONS CODING STATUS REPORT"
D HDR F I=1:1 Q:'$D(VALMHDR(I)) W !,VALMHDR(I)
I FIRST W !,$$REPEAT^XLFSTR("=",80),! S FIRST=0 Q
W !,"Visit Date",?24,"Patient Name",?44,"Chart #"
W !?54,"Serv",?60,"Insurance",!,$$REPEAT^XLFSTR("=",80),!
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("BDGICS3",$J) K BDGPRT
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)
BDGICS3 ; IHS/OIT/LJF - OBSERVATIONS CODING STATUS ; [ 04/08/2004 4:02 PM ]
+1 ;;5.3;PIMS;**1005,1010**;MAY 28, 2004
+2 ;IHS/OIT/LJF 02/16/2006 PATCH 1005 new routine
+3 ;cmi/anch/maw 10/20/2008 PATCH 1010 changed export date field from .14 to 1106
+4 ;
+5 NEW BDGBM,BDGEM
+6 SET BDGBM=$$READ^BDGF("DO^::EP","Select Beginning Month")
IF BDGBM<1
QUIT
+7 SET BDGEM=$$READ^BDGF("DO^::EP","Select Ending Month")
IF BDGEM<1
QUIT
+8 SET BDGBM=$EXTRACT(BDGBM,1,5)_"00"
SET BDGEM=$EXTRACT(BDGEM,1,5)_"31.24"
+9 ;
+10 DO ZIS^BDGF("PQ","EN^BDGICS3","OBSERVATION CODING STATUS","BDGBM;BDGEM")
+11 QUIT
+12 ;
+13 ;
EN ;EP; -- main entry point for BDG IC CODE STATUS DS
+1 NEW VALMCNT
+2 ;if printing to paper
IF $EXTRACT(IOST,1,2)="P-"
SET BDGPRT=1
DO INIT
DO PRINT
QUIT
+3 DO TERM^VALM0
DO CLEAR^VALM1
+4 DO EN^VALM("BDG IC CODE STATUS OBS")
+5 DO CLEAR^VALM1
+6 QUIT
+7 ;
HDR ;EP; -- header code
+1 NEW X
+2 SET VALMHDR(1)=$$SP(20)_$$CONF^BDGF
+3 SET X=$$GET1^DIQ(4,DUZ(2),.01)
SET VALMHDR(2)=$$SP(79-$LENGTH(X)\2)_X
+4 SET X=$$RANGE^BDGF(BDGBM,(BDGEM\1))
+5 SET VALMHDR(3)=$$SP(79-$LENGTH(X)\2)_X
+6 QUIT
+7 ;
INIT ;EP; -- init variables and list array
+1 IF '$GET(BDGPRT)
DO MSG^BDGF("Please wait while I compile the list...",2,0)
+2 NEW DATE,TODAY,DFN,IEN,COUNT,VST,VH,MONTH,SUB,ADM,X,LINE,DSC,Y
+3 KILL ^TMP("BDGICS3",$JOB),^TMP("BDGICS3A",$JOB)
+4 SET VALMCNT=0
+5 ;
+6 ; loop through observation visits for date range
+7 SET DATE=BDGBM
SET TODAY=DT+.24
+8 FOR
SET DATE=$ORDER(^AUPNVSIT("B",DATE))
IF ('DATE)!(DATE>BDGEM)!(DATE>TODAY)
QUIT
Begin DoDot:1
+9 SET MONTH=$EXTRACT(DATE,1,5)
+10 SET VST=0
FOR
SET VST=$ORDER(^AUPNVSIT("B",DATE,VST))
IF 'VST
QUIT
Begin DoDot:2
+11 ;
+12 IF $$GET1^DIQ(9000010,VST,.07)'="OBSERVATION"
QUIT
+13 IF $$GET1^DIQ(9000010,VST,.11)="DELETED"
QUIT
+14 ;visit from different facility
IF $$GET1^DIQ(9000010,VST,.06,"I")'=DUZ(2)
QUIT
+15 ;
+16 ;increment # observations per month
+17 SET COUNT(MONTH,"OBS")=$GET(COUNT(MONTH,"OBS"))+1
+18 ;
+19 ; check if uncoded
+20 SET X=$ORDER(^AUPNVPOV("AD",VST,0))
SET Y=$ORDER(^AUPNVPRV("AD",VST,0))
+21 IF (X="")!(Y="")
DO UNCODED(DATE,VST)
QUIT
+22 ;
+23 ; check if exported
+24 SET COUNT(MONTH,"COD")=$GET(COUNT(MONTH,"COD"))+1
+25 ;I $$GET1^DIQ(9000010,VST,.14)]"" S COUNT(MONTH,"EXP")=$G(COUNT(MONTH,"EXP"))+1 ;cmi/maw 10/20/2008 PATCH 1010 orig line
+26 ;cmi/maw 10/20/2008 PATCH 1010 new export date
IF $$GET1^DIQ(9000010,VST,1106)]""
SET COUNT(MONTH,"EXP")=$GET(COUNT(MONTH,"EXP"))+1
End DoDot:2
End DoDot:1
+27 ;
+28 ; build display array
+29 ; monthly counts heading
+30 SET LINE=$$PAD($$PAD("Month/Year",13)_"# Obsrv Vsts",26)
+31 SET LINE=$$PAD(LINE_"# Coded",36)
+32 SET LINE=$$PAD($$PAD(LINE_"# Not-Coded",50)_"# Exported",62)
+33 SET LINE=LINE_"# Errors"
DO SET(LINE,.VALMCNT)
+34 ; monthly counts
+35 SET MON=0
FOR
SET MON=$ORDER(COUNT(MON))
IF 'MON
QUIT
Begin DoDot:1
+36 SET LINE=$$PAD($$FMTE^XLFDT(MON_"00"),15)
+37 FOR SUB="OBS","COD","UNC","EXP","ERR"
Begin DoDot:2
+38 SET LINE=LINE_$JUSTIFY(+$GET(COUNT(MON,SUB)),4)_$$SP(8)
End DoDot:2
+39 DO SET(LINE,.VALMCNT)
End DoDot:1
+40 ;
+41 ;add totals for each column
+42 DO SET($$REPEAT^XLFSTR("=",79),.VALMCNT)
+43 SET LINE=$$SP(15)
+44 FOR SUB="OBS","COD","UNC","EXP","ERR"
Begin DoDot:1
+45 SET TOTAL=0
SET MON=0
+46 FOR
SET MON=$ORDER(COUNT(MON))
IF 'MON
QUIT
SET TOTAL=$GET(TOTAL)+$GET(COUNT(MON,SUB))
+47 SET LINE=LINE_$JUSTIFY(TOTAL,4)_$$SP(8)
End DoDot:1
+48 DO SET(LINE,.VALMCNT)
+49 DO SET("",.VALMCNT)
+50 ;
+51 ; list uncoded charts
+52 ; if any uncoded charts, print heading
+53 IF $DATA(^TMP("BDGICS3A",$JOB,"U"))
Begin DoDot:1
+54 SET LINE=$$PAD($$PAD("Visit Date",15)_"Patient Name",45)
+55 SET LINE=$$PAD(LINE_"Chart #",58)_"Srv"
+56 SET LINE=$$PAD(LINE,64)_"Insurance"
+57 DO SET("",.VALMCNT)
DO SET(LINE,.VALMCNT)
End DoDot:1
+58 ;
+59 SET DATE=0
FOR
SET DATE=$ORDER(^TMP("BDGICS3A",$JOB,"U",DATE))
IF 'DATE
QUIT
Begin DoDot:1
+60 SET VST=0
FOR
SET VST=$ORDER(^TMP("BDGICS3A",$JOB,"U",DATE,VST))
IF 'VST
QUIT
Begin DoDot:2
+61 ;
+62 ;pat ien
SET DFN=$$GET1^DIQ(9000010,VST,.05,"I")
+63 ;admit date
SET LINE=$$PAD($$NUMDATE^BDGF(DATE\1),15)
+64 ;name
SET LINE=$$PAD(LINE_$EXTRACT($$GET1^DIQ(2,DFN,.01),1,22),45)
+65 SET LINE=$$PAD(LINE_$JUSTIFY($$HRCN^BDGF2(DFN,DUZ(2)),6),58)
+66 ;
+67 SET ADM=$ORDER(^DGPM("AVISIT",VST,0))
+68 ;service
IF ADM
SET LINE=LINE_$EXTRACT($$ADMSRV^BDGF1(ADM,DFN),1,3)
+69 ;
+70 ; add insurance coverage
+71 SET LINE=$$PAD(LINE,64)_$$INSUR^BDGF2(DFN,DATE)
+72 DO SET(LINE,.VALMCNT)
End DoDot:2
End DoDot:1
+73 ;
+74 ; add error charts to display listing
+75 ; if any errors, print heading
+76 IF $DATA(^TMP("BDGICS3A",$JOB,"E"))
Begin DoDot:1
+77 ;mark errors for paper
IF $EXTRACT(IOST,1,2)="P-"
DO SET("@@@",.VALMCNT)
+78 SET LINE=$$PAD("Visit Date",16)_"Patient Name"
+79 SET LINE=$$PAD($$PAD(LINE,38)_"Chart #",48)_"Error Message"
+80 DO SET("",.VALMCNT)
DO SET(LINE,.VALMCNT)
End DoDot:1
+81 ;
+82 SET DATE=0
FOR
SET DATE=$ORDER(^TMP("BDGICS3A",$JOB,"E",DATE))
IF 'DATE
QUIT
Begin DoDot:1
+83 SET VST=0
FOR
SET VST=$ORDER(^TMP("BDGICS3A",$JOB,"E",DATE,VST))
IF 'VST
QUIT
Begin DoDot:2
+84 ;
+85 ;pat ien
SET DFN=$$GET1^DIQ(9000010,VST,.05,"I")
+86 ;admit date
SET LINE=$$PAD($$NUMDATE^BDGF(DATE\1),16)
+87 ;name
SET LINE=$$PAD(LINE_$EXTRACT($$GET1^DIQ(2,DFN,.01),1,18),38)
+88 ;chart #
SET LINE=LINE_$JUSTIFY($$HRCN^BDGF2(DFN,DUZ(2)),6)
+89 ;err msg
SET LINE=$$PAD(LINE,48)_^TMP("BDGICS3A",$JOB,"E",DATE,VST)
+90 DO SET(LINE,.VALMCNT)
End DoDot:2
End DoDot:1
+91 ;
+92 IF '$DATA(^TMP("BDGICS3",$JOB))
DO SET("NO DATA FOUND",.VALMCNT)
+93 KILL ^TMP("BDGICS3A",$JOB)
+94 QUIT
+95 ;
ERR(MSG,VST,DATE) ; increment error count and save for listing
+1 NEW MON
+2 SET MON=$EXTRACT(DATE,1,5)
+3 SET COUNT(MON,"ERR")=$GET(COUNT(MON,"ERR"))+1
+4 SET ^TMP("BDGICS3A",$JOB,"E",DATE,VST)=MSG
+5 QUIT
+6 ;
UNCODED(DATE,VST) ; save uncoded visits by discharge date
+1 NEW MON
+2 SET MON=$EXTRACT(DATE,1,5)
+3 SET COUNT(MON,"UNC")=$GET(COUNT(MON,"UNC"))+1
+4 SET ^TMP("BDGICS3A",$JOB,"U",DATE,VST)=""
+5 QUIT
+6 ;
SET(DATA,NUM) ; put data line into display array
+1 SET NUM=NUM+1
+2 SET ^TMP("BDGICS3",$JOB,NUM,0)=DATA
+3 QUIT
+4 ;
PRINT ; print report to paper
+1 NEW BDGL,FIRST
+2 USE IO
SET FIRST=1
DO HDG
+3 SET BDGL=0
FOR
SET BDGL=$ORDER(^TMP("BDGICS3",$JOB,BDGL))
IF 'BDGL
QUIT
Begin DoDot:1
+4 ;beginning of errors
IF ^TMP("BDGICS3",$JOB,BDGL,0)="@@@"
SET FIRST=1
QUIT
+5 IF $Y>(IOSL-4)
DO HDG
+6 WRITE !,^TMP("BDGICS3",$JOB,BDGL,0)
End DoDot:1
+7 DO ^%ZISC
DO EXIT
+8 QUIT
+9 ;
HDG ; heading when printing to paper
+1 WRITE @IOF
WRITE !?25,"OBSERVATIONS CODING STATUS REPORT"
+2 DO HDR
FOR I=1:1
IF '$DATA(VALMHDR(I))
QUIT
WRITE !,VALMHDR(I)
+3 IF FIRST
WRITE !,$$REPEAT^XLFSTR("=",80),!
SET FIRST=0
QUIT
+4 WRITE !,"Visit Date",?24,"Patient Name",?44,"Chart #"
+5 WRITE !?54,"Serv",?60,"Insurance",!,$$REPEAT^XLFSTR("=",80),!
+6 QUIT
+7 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("BDGICS3",$JOB)
KILL BDGPRT
+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)
