BDGICR1 ; IHS/ANMC/LJF - INCOMPLETE CHART BY PATIENT ; [ 08/20/2004 11:45 AM ]
;;5.3;PIMS;**1001,1005**;MAY 28, 2004
;IHS/ITSC/WAR 07/23/2004 PATCH 1001 added printable date range
;IHS/ITSC/LJF 08/09/2004 PATCH 1001 combined boservations with day surgery listing
;IHS/OIT/LJF 02/16/2006 PATCH 1005 added discharge or visit date sort
; 04/05/2006 PATCH 1005 added new subtotals (by deficiency & coded vs. ready to code)
;
NEW BDGTYP,DEFAULT,BDGBD,BDGED,BDGSEL,BDGSRT
;
;S BDGTYP=$$READ^BDGF("SO^1:Inpatients Only;2:Day Surgeries Only;3:Both","Select Visit Types to Include") Q:BDGTYP<1
S BDGTYP=$$READ^BDGF("SO^1:Inpatients;2:Observations & Day Surgeries;3:All","Select Visit Types to Include") Q:BDGTYP<1 ;IHS/ITSC/LJF 8/9/2004 PATCH #1001
;
;S DEFAULT=$S(BDGTYP=1:"Discharge",BDGTYP=2:"Surgery",1:"Discharge/Surgery")
S DEFAULT=$S(BDGTYP=1:"Discharge",1:"Discharge/Surgery") ;IHS/ITSC/LJF 8/9/2004 PATCH #1001
S BDGBD=$$READ^BDGF("DO^::EX","Select Beginning "_DEFAULT_" Date")
Q:BDGBD<1
S BDGED=$$READ^BDGF("DO^::EX","Select Ending "_DEFAULT_" Date")
Q:BDGED<1
;IHS/ITSC/WAR 7/23/04 PATCH #1001 printable date range
S BDGDTS="from "_$E(BDGBD,4,5)_"/"_$E(BDGBD,6,7)_"/"_($E(BDGBD,1,3)+1700)
S BDGDTS=BDGDTS_" to "_$E(BDGED,4,5)_"/"_$E(BDGED,6,7)_"/"_($E(BDGED,1,3)+1700)
;End of 7/23/04 PATCH #1001
;
S BDGSEL=$$SELECT Q:BDGSEL=U
;
;IHS/OIT/LJF 02/16/2006 PATCH 1005
;S BDGSRT=$$READ^BDGF("SO^1:Sort Alphabetically by Name;2:Sort by Terminal Digit","Select Patient Sort") Q:BDGSRT<1
S X=$S(BDGTYP=1:"Discharge",1:"Discharge/Surgery")
S BDGSRT=$$READ^BDGF("SO^1:Sort Alphabetically by Name;2:Sort by Terminal Digit;3:Sort by "_X_" Date","Select Patient Sort") Q:BDGSRT<1
;
;IHS/OIT/LJF 04/05/2006 PATCH 1005 add 2 more questions
NEW BDGDEF,BDGRTC
S BDGDEF=$$READ^BDGF("Y","Include COUNTS by CHART DEFICIENCY","NO") Q:BDGDEF=U
S BDGRTC=$$READ^BDGF("Y","Subtotal CODED vs. READY TO CODE","NO") Q:BDGRTC=U
;
I $$BROWSE^BDGF="B" D EN Q
;IHS/ITSC/WAR 7/23/04 PATCH #1001 printable date range
;IHS/OIT/LJF 04/05/2006 PATCH 1005 added BDGDEF & BDGRTC to variable list
;D ZIS^BDGF("PQM","EN^BDGICR1","IC LIST BY PATIENT","BDGTYP;BDGBD;BDGED;BDGSEL;BDGSRT")
;D ZIS^BDGF("PQM","EN^BDGICR1","IC LIST BY PATIENT","BDGTYP;BDGBD;BDGED;BDGSEL;BDGSRT;BDGDTS")
D ZIS^BDGF("PQM","EN^BDGICR1","IC LIST BY PATIENT","BDGTYP;BDGBD;BDGED;BDGSEL;BDGSRT;BDGDTS;BDGDEF;BDGRTC")
Q
;
;
EN ; -- main entry point for BDG IC CHARTS BY PATIENT
I $E(IOST,1,2)="P-" S BDGPRT=1 D INIT,PRINT Q ;printing to paper
NEW VALMCNT D TERM^VALM0,CLEAR^VALM1
D EN^VALM("BDG IC CHARTS BY PATIENT")
D CLEAR^VALM1
Q
;
HDR ; -- header code
NEW X
S VALMHDR(1)=$$SP(15)_$$CONF^BDGF
;
;IHS/ITSC/LJF 8/9/2004 PATCH #1001
;S X=$S(BDGTYP=1:"Inpatients Only",BDGTYP=2:"Day Surgeries Only",1:"Inpatients & Day Surgeries")
S X=$S(BDGTYP=1:"Inpatients",BDGTYP=2:"Observations & Day Surgeries",1:"Inpatients, Observations & Day Surgeries")
;
S X=X_" ("_$P($T(CHOICE+BDGSEL),";;",2)_")" ;chart selection
S VALMHDR(2)=$$SP(75-$L(X)\2)_X
;IHS/ITSC/WAR 7/23/04 PATCH #1001 NextLine Center printable date range
S VALMHDR(3)=$$SP(75-$L(BDGDTS)\2)_BDGDTS
Q
;
INIT ; -- init variables and list array
I '$G(BDGPRT) D MSG^BDGF("Please wait while I compile the list...",2,0)
K ^TMP("BDGICR1",$J),^TMP("BDGICR1A",$J)
S VALMCNT=0
;
; first find incomplete entries by date range & sort by patient
NEW DATE,END,BDGCNT
S DATE=BDGBD-.0001,END=BDGED+.24
;I BDGTYP'=1 D FIND("AS" ;gather day surgeries
I BDGTYP'=1 D FIND("AS"),FIND("AD",1) ;gather day surgeries & observations;IHS/ITSC/LJF 8/9/2004 PATCH #1001
I BDGTYP'=2 D FIND("AD") ;gather inpatients
;
; now take sorted list and put into display array
;NEW SORT,IEN,LINE,PRV,NAME
NEW SORT,IEN,LINE,PRV,NAME,IEN2 ;IHS/ITSC/LJF 5/29/2004; PATCH #1001
S SORT=0
F S SORT=$O(^TMP("BDGICR1A",$J,SORT)) Q:SORT="" D
. S IEN=0 F S IEN=$O(^TMP("BDGICR1A",$J,SORT,IEN)) Q:'IEN D
.. ;
.. ; build display line
.. S LINE=$$PAD($$GET1^DIQ(9009016.1,IEN,.01),20) ;patient
.. S LINE=LINE_$J($$GET1^DIQ(9009016.1,IEN,.011),8) ;chart #
.. S LINE=$$PAD(LINE,30)_$$DATES(IEN,1) ;admit/surg date
.. S LINE=$$PAD(LINE,48)_$$WRD(IEN) ;type or ward
.. S LINE=$$PAD(LINE,61)_$$CODE(IEN,1) ;ready to code
.. S LINE=$$PAD(LINE,81)_$$GET1^DIQ(9009016.1,IEN,.0391) ;insurance
.. D SET(LINE,.VALMCNT)
.. ;
.. ; build 2nd line
.. S LINE=$$SP(30)_$$DATES(IEN,2) ;discharge date
.. S LINE=$$PAD(LINE,48)_$$SRV(IEN) ;srv
.. S LINE=$$PAD(LINE,61)_$$CODE(IEN,2) ;date coded
.. S LINE=$$PAD(LINE,81)_$$GET1^DIQ(9009016.1,IEN,.18) ;comments
.. D SET(LINE,.VALMCNT)
.. ;
.. ; now list unresolved deficiencies
.. S PRV=0 F S PRV=$O(^BDGIC(IEN,1,"B",PRV)) Q:'PRV D
... S IEN2=0 F S IEN2=$O(^BDGIC(IEN,1,"B",PRV,IEN2)) Q:'IEN2 D
.... Q:$$GET1^DIQ(9009016.11,IEN2_","_IEN,.03)]"" ;resolved
.... Q:$$GET1^DIQ(9009016.11,IEN2_","_IEN,.04)]"" ;deleted
.... S LINE=$$SP(81)_$E($$GET1^DIQ(200,PRV,.01),1,18)
.... S LINE=$$PAD(LINE,101)_$$GET1^DIQ(9009016.11,IEN2_","_IEN,.02)
.... D SET($$PAD(LINE,132),.VALMCNT)
.... ;
.... ;IHS/OIT/LJF 04/05/2006 PATCH 1005 count by deficiency
.... I BDGDEF S X=$$GET1^DIQ(9009016.11,IEN2_","_IEN,.02) S BDGDEF(X)=$G(BDGDEF(X))+1
.. ;
.. ;IHS/OIT/LJF 04/05/2006 PATCH 1005 count by coding status
.. I BDGRTC D
... I $$GET1^DIQ(9009016.1,IEN,.13)]"" S BDGRTC("CODED")=$G(BDGRTC("CODED"))+1
... E I $$GET1^DIQ(9009016.1,IEN,.12)]"" S BDGRTC("READY TO CODE")=$G(BDGRTC("READY TO CODE"))+1
... E S BDGRTC("NOT READY")=$G(BDGRTC("NOT READY"))+1
.. ;
.. ;
.. D SET("",.VALMCNT) ;blank line between patient entries
;
;IHS/OIT/LJF 04/05/2006 PATCH 1005 display subtotals
;I $G(BDGCNT)>0 D SET("TOTAL INCOMPLETE CHARTS: "_BDGCNT,.VALMCNT)
I $G(BDGCNT)>0 D
. D SET("TOTAL INCOMPLETE CHARTS: "_BDGCNT,.VALMCNT)
. I BDGDEF D D SET("",.VALMCNT)
.. D SET(" SUBCOUNTS BY DEFICIENCY:",.VALMCNT)
.. I $O(BDGDEF(0))="" D SET($$SP(5)_"NO DEFICIENCIES FOUND",.VALMCNT)
.. S X=0 F S X=$O(BDGDEF(X)) Q:X="" D SET($$SP(5)_$$PAD(X,32)_BDGDEF(X),.VALMCNT)
. I BDGRTC D
.. D SET(" SUBCOUNTS BY CODING STATUS",.VALMCNT)
.. F I="CODED","READY TO CODE","NOT READY" D SET($$SP(5)_$$PAD(I,20)_(+$G(BDGRTC(I))),.VALMCNT)
;IHS/OIT/LJF 04/05/2006 end of PATCH 1005 changes
;
I '$D(^TMP("BDGICR1",$J)) D SET("NO DATA FOUND",.VALMCNT)
K ^TMP("BDGICR1A",$J)
Q
;
FIND(SUB,OBS) ; find all inpatient entries for date range
; SUB=subscript depending on visit type
; OBS=1 if looking for observation patients; optional ;IHS/ITSC/LJF 8/9/2004 PATCH #1001
NEW DATE,END,IEN,SORT
S DATE=BDGBD-.0001,END=BDGED+.24
F S DATE=$O(^BDGIC(SUB,DATE)) Q:'DATE Q:(DATE>END) D
. S IEN=0 F S IEN=$O(^BDGIC(SUB,DATE,IEN)) Q:'IEN D
.. ;
.. I $G(OBS),$$GET1^DIQ(9009016.1,IEN,.0392)'="OBSERVATION" Q ;IHS/ITSC/LJF 8/9/2004 PATCH #1001
.. ;
.. ; check entry against user selection
.. K DATA D ENP^XBDIQ1(9009016.1,IEN,".11:.21","DATA(")
.. Q:DATA(.17)]"" ;quit if deleted
.. I BDGSEL'=7 Q:DATA(.14)]"" ;quit if completed
.. I BDGSEL=2 Q:DATA(.11)]"" ;quit if received
.. I BDGSEL=3 Q:DATA(.19)]"" ;quit if tagged
.. I BDGSEL=4 Q:DATA(.21)]"" ;quit if insur iden
.. I BDGSEL=5 Q:DATA(.13)]"" ;quit if coded
.. I BDGSEL=6 Q:DATA(.13)="" ;quit if not coded
.. I BDGSEL=7 Q:DATA(.14)="" Q:DATA(.15)]"" ;quit not in bill p
.. ;
.. ;IHS/OIT/LJF 02/16/2006 PATCH 1005 add date as sort choice
.. ; set sort value to patient name or chart #
.. ;S SORT=$$GET1^DIQ(9009016.1,IEN,$S(BDGSRT=1:.01,1:.011))
.. S SORT=$$GET1^DIQ(9009016.1,IEN,$S(BDGSRT=1:.01,BDGSRT=2:.011,BDGTYP=1:.02,1:.03),$S(BDGSRT=3:"I",1:""))
.. I BDGSRT=3,BDGTYP=2 S SORT=$$GET1^DIQ(9000010,SORT,.01,"I") ;convert visit pointer to date
.. ;
.. I BDGSRT=2 S SORT=$$HRCNT^BDGF2(SORT) ;convert to terminal digit
.. ;
.. S ^TMP("BDGICR1A",$J,SORT,IEN)=""
.. S BDGCNT=$G(BDGCNT)+1
Q
;
DATES(IEN,NUM) ; return dates for entry
; NUM=1 for visit date, =2 for discharge date
NEW X
I NUM=2 Q $$NUMDATE^BDGF($$GET1^DIQ(9009016.1,IEN,.02,"I")\1,1)
S X=$$GET1^DIQ(9009016.1,IEN,.03,"I") I 'X Q "??" ;visit ien
Q $$NUMDATE^BDGF($$GET1^DIQ(9000010,X,.01,"I")\1,1) ;visit date
;
WRD(IEN) ; returns ds type or ward
NEW TYPE,X,DATE,CA,PAT
S TYPE=$$GET1^DIQ(9009016.1,IEN,.0392) ;visit type
;I TYPE'["HOS" Q $S(TYPE["DAY":"DS",TYPE["OBS":"DSO",1:"??")
I TYPE'["HOS" Q $S(TYPE["DAY":"DS",TYPE["OBS":"OBS",1:"??") ;IHS/ITSC/LJF 8/9/2004 PATCH #1001
;
; for inpatients
S V=$$GET1^DIQ(9009016.1,IEN,.03,"I") ;visit
S X=$O(^DGPM("AVISIT",V,0)) I 'X Q "??" ;link to 405
Q $$GET1^DIQ(405,+$$GET1^DIQ(405,X,.17,"I"),200) ;ward at discharge
;
SRV(IEN) ; returns service
Q $$GET1^DIQ(45.7,+$$GET1^DIQ(9009016.1,IEN,.04,"I"),99)
;
CODE(IEN,NUM) ; returns ready to code date and date coded
; NUM=1 for ready to code; =2 for date coded
NEW X,Y
I NUM=1 Q $$NUMDATE^BDGF($$GET1^DIQ(9009016.1,IEN,.12,"I"),1)
Q $$NUMDATE^BDGF($$GET1^DIQ(9009016.1,IEN,.13,"I"),1)
;
SET(DATA,NUM) ; puts display line into list template array
S NUM=NUM+1
S ^TMP("BDGICR1",$J,NUM,0)=DATA
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("BDGICR1",$J) K BDGPRT
Q
;
EXPND ; -- expand code
Q
;
PRINT ; print report to paper
NEW BDGX,BDGLN,BDGPG
U IO D INIT^BDGF ;initialize heading variables
D HDG
;
; loop thru display array
S BDGX=0 F S BDGX=$O(^TMP("BDGICR1",$J,BDGX)) Q:'BDGX D
. I $Y>(IOSL-4) D HDG
. S BDGLN=^TMP("BDGICR1",$J,BDGX,0)
. W !,BDGLN
D ^%ZISC,PRTKL^BDGF,EXIT
Q
;
HDG ; heading for paper report
S BDGPG=$G(BDGPG)+1 I BDGPG>1 W @IOF
W !,BDGUSR,?11,"*****",$$CONF^BDGF,"*****"
W !,BDGDATE,?25,"Incomplete Charts by Patient",?70,"Page: ",BDGPG
;
;IHS/ITSC/LJF 8/9/2004 PATCH 1001
;NEW X S X=$S(BDGTYP=1:"Inpatient Charts Only",BDGTYP=2:"Day Surgery Charts Only",1:"Inpatient and Day Surgery Charts")
NEW X S X=$S(BDGTYP=1:"Inpatients",BDGTYP=2:"Observations & Day Surgeries",1:"Inpatients, Observations & Day Surgeries")
;
S X=X_"("_$P($T(CHOICE+BDGSEL),";;",2)_")"
W !,BDGTIME,?(80-$L(X)\2),X
;IHS/ITSC/WAR 7/23/04 PATCH #1001 Next line center printable date range
W !,?(80-$L(BDGDTS)\2),BDGDTS
W !,$$REPEAT^XLFSTR("-",80)
W !?2,"Patient",?23,"HRCN",?30,"Admt/Dsch",?45,"Ward/Srv",?60
W "Ready/Coded",?81,"Insurance/Unresolved Deficiencies & Comments"
W !,$$REPEAT^XLFSTR("=",80)
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)
;
SELECT() ; ask user to choose selected charts
NEW Y,ARRAY,I
W !!
F I=1:1:7 S ARRAY(I)=" "_I_". "_$P($T(CHOICE+I),";;",2)
S Y=$$READ^BDGF("NO^1:7","Select Charts to Print",1,"","",.ARRAY)
Q Y
;
CHOICE ;;
;;All Incomplete Charts;;
;;Charts Not Yet Received;;
;;Charts Not Yet Tagged;;
;;Insurance Not Identified;;
;;Not Coded (Tagged or Not);;
;;Coded, Not Completed;;
;;Completed, In Bill Prep;;
BDGICR1 ; IHS/ANMC/LJF - INCOMPLETE CHART BY PATIENT ; [ 08/20/2004 11:45 AM ]
+1 ;;5.3;PIMS;**1001,1005**;MAY 28, 2004
+2 ;IHS/ITSC/WAR 07/23/2004 PATCH 1001 added printable date range
+3 ;IHS/ITSC/LJF 08/09/2004 PATCH 1001 combined boservations with day surgery listing
+4 ;IHS/OIT/LJF 02/16/2006 PATCH 1005 added discharge or visit date sort
+5 ; 04/05/2006 PATCH 1005 added new subtotals (by deficiency & coded vs. ready to code)
+6 ;
+7 NEW BDGTYP,DEFAULT,BDGBD,BDGED,BDGSEL,BDGSRT
+8 ;
+9 ;S BDGTYP=$$READ^BDGF("SO^1:Inpatients Only;2:Day Surgeries Only;3:Both","Select Visit Types to Include") Q:BDGTYP<1
+10 ;IHS/ITSC/LJF 8/9/2004 PATCH #1001
SET BDGTYP=$$READ^BDGF("SO^1:Inpatients;2:Observations & Day Surgeries;3:All","Select Visit Types to Include")
IF BDGTYP<1
QUIT
+11 ;
+12 ;S DEFAULT=$S(BDGTYP=1:"Discharge",BDGTYP=2:"Surgery",1:"Discharge/Surgery")
+13 ;IHS/ITSC/LJF 8/9/2004 PATCH #1001
SET DEFAULT=$SELECT(BDGTYP=1:"Discharge",1:"Discharge/Surgery")
+14 SET BDGBD=$$READ^BDGF("DO^::EX","Select Beginning "_DEFAULT_" Date")
+15 IF BDGBD<1
QUIT
+16 SET BDGED=$$READ^BDGF("DO^::EX","Select Ending "_DEFAULT_" Date")
+17 IF BDGED<1
QUIT
+18 ;IHS/ITSC/WAR 7/23/04 PATCH #1001 printable date range
+19 SET BDGDTS="from "_$EXTRACT(BDGBD,4,5)_"/"_$EXTRACT(BDGBD,6,7)_"/"_($EXTRACT(BDGBD,1,3)+1700)
+20 SET BDGDTS=BDGDTS_" to "_$EXTRACT(BDGED,4,5)_"/"_$EXTRACT(BDGED,6,7)_"/"_($EXTRACT(BDGED,1,3)+1700)
+21 ;End of 7/23/04 PATCH #1001
+22 ;
+23 SET BDGSEL=$$SELECT
IF BDGSEL=U
QUIT
+24 ;
+25 ;IHS/OIT/LJF 02/16/2006 PATCH 1005
+26 ;S BDGSRT=$$READ^BDGF("SO^1:Sort Alphabetically by Name;2:Sort by Terminal Digit","Select Patient Sort") Q:BDGSRT<1
+27 SET X=$SELECT(BDGTYP=1:"Discharge",1:"Discharge/Surgery")
+28 SET BDGSRT=$$READ^BDGF("SO^1:Sort Alphabetically by Name;2:Sort by Terminal Digit;3:Sort by "_X_" Date","Select Patient Sort")
IF BDGSRT<1
QUIT
+29 ;
+30 ;IHS/OIT/LJF 04/05/2006 PATCH 1005 add 2 more questions
+31 NEW BDGDEF,BDGRTC
+32 SET BDGDEF=$$READ^BDGF("Y","Include COUNTS by CHART DEFICIENCY","NO")
IF BDGDEF=U
QUIT
+33 SET BDGRTC=$$READ^BDGF("Y","Subtotal CODED vs. READY TO CODE","NO")
IF BDGRTC=U
QUIT
+34 ;
+35 IF $$BROWSE^BDGF="B"
DO EN
QUIT
+36 ;IHS/ITSC/WAR 7/23/04 PATCH #1001 printable date range
+37 ;IHS/OIT/LJF 04/05/2006 PATCH 1005 added BDGDEF & BDGRTC to variable list
+38 ;D ZIS^BDGF("PQM","EN^BDGICR1","IC LIST BY PATIENT","BDGTYP;BDGBD;BDGED;BDGSEL;BDGSRT")
+39 ;D ZIS^BDGF("PQM","EN^BDGICR1","IC LIST BY PATIENT","BDGTYP;BDGBD;BDGED;BDGSEL;BDGSRT;BDGDTS")
+40 DO ZIS^BDGF("PQM","EN^BDGICR1","IC LIST BY PATIENT","BDGTYP;BDGBD;BDGED;BDGSEL;BDGSRT;BDGDTS;BDGDEF;BDGRTC")
+41 QUIT
+42 ;
+43 ;
EN ; -- main entry point for BDG IC CHARTS BY PATIENT
+1 ;printing to paper
IF $EXTRACT(IOST,1,2)="P-"
SET BDGPRT=1
DO INIT
DO PRINT
QUIT
+2 NEW VALMCNT
DO TERM^VALM0
DO CLEAR^VALM1
+3 DO EN^VALM("BDG IC CHARTS BY PATIENT")
+4 DO CLEAR^VALM1
+5 QUIT
+6 ;
HDR ; -- header code
+1 NEW X
+2 SET VALMHDR(1)=$$SP(15)_$$CONF^BDGF
+3 ;
+4 ;IHS/ITSC/LJF 8/9/2004 PATCH #1001
+5 ;S X=$S(BDGTYP=1:"Inpatients Only",BDGTYP=2:"Day Surgeries Only",1:"Inpatients & Day Surgeries")
+6 SET X=$SELECT(BDGTYP=1:"Inpatients",BDGTYP=2:"Observations & Day Surgeries",1:"Inpatients, Observations & Day Surgeries")
+7 ;
+8 ;chart selection
SET X=X_" ("_$PIECE($TEXT(CHOICE+BDGSEL),";;",2)_")"
+9 SET VALMHDR(2)=$$SP(75-$LENGTH(X)\2)_X
+10 ;IHS/ITSC/WAR 7/23/04 PATCH #1001 NextLine Center printable date range
+11 SET VALMHDR(3)=$$SP(75-$LENGTH(BDGDTS)\2)_BDGDTS
+12 QUIT
+13 ;
INIT ; -- init variables and list array
+1 IF '$GET(BDGPRT)
DO MSG^BDGF("Please wait while I compile the list...",2,0)
+2 KILL ^TMP("BDGICR1",$JOB),^TMP("BDGICR1A",$JOB)
+3 SET VALMCNT=0
+4 ;
+5 ; first find incomplete entries by date range & sort by patient
+6 NEW DATE,END,BDGCNT
+7 SET DATE=BDGBD-.0001
SET END=BDGED+.24
+8 ;I BDGTYP'=1 D FIND("AS" ;gather day surgeries
+9 ;gather day surgeries & observations;IHS/ITSC/LJF 8/9/2004 PATCH #1001
IF BDGTYP'=1
DO FIND("AS")
DO FIND("AD",1)
+10 ;gather inpatients
IF BDGTYP'=2
DO FIND("AD")
+11 ;
+12 ; now take sorted list and put into display array
+13 ;NEW SORT,IEN,LINE,PRV,NAME
+14 ;IHS/ITSC/LJF 5/29/2004; PATCH #1001
NEW SORT,IEN,LINE,PRV,NAME,IEN2
+15 SET SORT=0
+16 FOR
SET SORT=$ORDER(^TMP("BDGICR1A",$JOB,SORT))
IF SORT=""
QUIT
Begin DoDot:1
+17 SET IEN=0
FOR
SET IEN=$ORDER(^TMP("BDGICR1A",$JOB,SORT,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+18 ;
+19 ; build display line
+20 ;patient
SET LINE=$$PAD($$GET1^DIQ(9009016.1,IEN,.01),20)
+21 ;chart #
SET LINE=LINE_$JUSTIFY($$GET1^DIQ(9009016.1,IEN,.011),8)
+22 ;admit/surg date
SET LINE=$$PAD(LINE,30)_$$DATES(IEN,1)
+23 ;type or ward
SET LINE=$$PAD(LINE,48)_$$WRD(IEN)
+24 ;ready to code
SET LINE=$$PAD(LINE,61)_$$CODE(IEN,1)
+25 ;insurance
SET LINE=$$PAD(LINE,81)_$$GET1^DIQ(9009016.1,IEN,.0391)
+26 DO SET(LINE,.VALMCNT)
+27 ;
+28 ; build 2nd line
+29 ;discharge date
SET LINE=$$SP(30)_$$DATES(IEN,2)
+30 ;srv
SET LINE=$$PAD(LINE,48)_$$SRV(IEN)
+31 ;date coded
SET LINE=$$PAD(LINE,61)_$$CODE(IEN,2)
+32 ;comments
SET LINE=$$PAD(LINE,81)_$$GET1^DIQ(9009016.1,IEN,.18)
+33 DO SET(LINE,.VALMCNT)
+34 ;
+35 ; now list unresolved deficiencies
+36 SET PRV=0
FOR
SET PRV=$ORDER(^BDGIC(IEN,1,"B",PRV))
IF 'PRV
QUIT
Begin DoDot:3
+37 SET IEN2=0
FOR
SET IEN2=$ORDER(^BDGIC(IEN,1,"B",PRV,IEN2))
IF 'IEN2
QUIT
Begin DoDot:4
+38 ;resolved
IF $$GET1^DIQ(9009016.11,IEN2_","_IEN,.03)]""
QUIT
+39 ;deleted
IF $$GET1^DIQ(9009016.11,IEN2_","_IEN,.04)]""
QUIT
+40 SET LINE=$$SP(81)_$EXTRACT($$GET1^DIQ(200,PRV,.01),1,18)
+41 SET LINE=$$PAD(LINE,101)_$$GET1^DIQ(9009016.11,IEN2_","_IEN,.02)
+42 DO SET($$PAD(LINE,132),.VALMCNT)
+43 ;
+44 ;IHS/OIT/LJF 04/05/2006 PATCH 1005 count by deficiency
+45 IF BDGDEF
SET X=$$GET1^DIQ(9009016.11,IEN2_","_IEN,.02)
SET BDGDEF(X)=$GET(BDGDEF(X))+1
End DoDot:4
End DoDot:3
+46 ;
+47 ;IHS/OIT/LJF 04/05/2006 PATCH 1005 count by coding status
+48 IF BDGRTC
Begin DoDot:3
+49 IF $$GET1^DIQ(9009016.1,IEN,.13)]""
SET BDGRTC("CODED")=$GET(BDGRTC("CODED"))+1
+50 IF '$TEST
IF $$GET1^DIQ(9009016.1,IEN,.12)]""
SET BDGRTC("READY TO CODE")=$GET(BDGRTC("READY TO CODE"))+1
+51 IF '$TEST
SET BDGRTC("NOT READY")=$GET(BDGRTC("NOT READY"))+1
End DoDot:3
+52 ;
+53 ;
+54 ;blank line between patient entries
DO SET("",.VALMCNT)
End DoDot:2
End DoDot:1
+55 ;
+56 ;IHS/OIT/LJF 04/05/2006 PATCH 1005 display subtotals
+57 ;I $G(BDGCNT)>0 D SET("TOTAL INCOMPLETE CHARTS: "_BDGCNT,.VALMCNT)
+58 IF $GET(BDGCNT)>0
Begin DoDot:1
+59 DO SET("TOTAL INCOMPLETE CHARTS: "_BDGCNT,.VALMCNT)
+60 IF BDGDEF
Begin DoDot:2
+61 DO SET(" SUBCOUNTS BY DEFICIENCY:",.VALMCNT)
+62 IF $ORDER(BDGDEF(0))=""
DO SET($$SP(5)_"NO DEFICIENCIES FOUND",.VALMCNT)
+63 SET X=0
FOR
SET X=$ORDER(BDGDEF(X))
IF X=""
QUIT
DO SET($$SP(5)_$$PAD(X,32)_BDGDEF(X),.VALMCNT)
End DoDot:2
DO SET("",.VALMCNT)
+64 IF BDGRTC
Begin DoDot:2
+65 DO SET(" SUBCOUNTS BY CODING STATUS",.VALMCNT)
+66 FOR I="CODED","READY TO CODE","NOT READY"
DO SET($$SP(5)_$$PAD(I,20)_(+$GET(BDGRTC(I))),.VALMCNT)
End DoDot:2
End DoDot:1
+67 ;IHS/OIT/LJF 04/05/2006 end of PATCH 1005 changes
+68 ;
+69 IF '$DATA(^TMP("BDGICR1",$JOB))
DO SET("NO DATA FOUND",.VALMCNT)
+70 KILL ^TMP("BDGICR1A",$JOB)
+71 QUIT
+72 ;
FIND(SUB,OBS) ; find all inpatient entries for date range
+1 ; SUB=subscript depending on visit type
+2 ; OBS=1 if looking for observation patients; optional ;IHS/ITSC/LJF 8/9/2004 PATCH #1001
+3 NEW DATE,END,IEN,SORT
+4 SET DATE=BDGBD-.0001
SET END=BDGED+.24
+5 FOR
SET DATE=$ORDER(^BDGIC(SUB,DATE))
IF 'DATE
QUIT
IF (DATE>END)
QUIT
Begin DoDot:1
+6 SET IEN=0
FOR
SET IEN=$ORDER(^BDGIC(SUB,DATE,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+7 ;
+8 ;IHS/ITSC/LJF 8/9/2004 PATCH #1001
IF $GET(OBS)
IF $$GET1^DIQ(9009016.1,IEN,.0392)'="OBSERVATION"
QUIT
+9 ;
+10 ; check entry against user selection
+11 KILL DATA
DO ENP^XBDIQ1(9009016.1,IEN,".11:.21","DATA(")
+12 ;quit if deleted
IF DATA(.17)]""
QUIT
+13 ;quit if completed
IF BDGSEL'=7
IF DATA(.14)]""
QUIT
+14 ;quit if received
IF BDGSEL=2
IF DATA(.11)]""
QUIT
+15 ;quit if tagged
IF BDGSEL=3
IF DATA(.19)]""
QUIT
+16 ;quit if insur iden
IF BDGSEL=4
IF DATA(.21)]""
QUIT
+17 ;quit if coded
IF BDGSEL=5
IF DATA(.13)]""
QUIT
+18 ;quit if not coded
IF BDGSEL=6
IF DATA(.13)=""
QUIT
+19 ;quit not in bill p
IF BDGSEL=7
IF DATA(.14)=""
QUIT
IF DATA(.15)]""
QUIT
+20 ;
+21 ;IHS/OIT/LJF 02/16/2006 PATCH 1005 add date as sort choice
+22 ; set sort value to patient name or chart #
+23 ;S SORT=$$GET1^DIQ(9009016.1,IEN,$S(BDGSRT=1:.01,1:.011))
+24 SET SORT=$$GET1^DIQ(9009016.1,IEN,$SELECT(BDGSRT=1:.01,BDGSRT=2:.011,BDGTYP=1:.02,1:.03),$SELECT(BDGSRT=3:"I",1:""))
+25 ;convert visit pointer to date
IF BDGSRT=3
IF BDGTYP=2
SET SORT=$$GET1^DIQ(9000010,SORT,.01,"I")
+26 ;
+27 ;convert to terminal digit
IF BDGSRT=2
SET SORT=$$HRCNT^BDGF2(SORT)
+28 ;
+29 SET ^TMP("BDGICR1A",$JOB,SORT,IEN)=""
+30 SET BDGCNT=$GET(BDGCNT)+1
End DoDot:2
End DoDot:1
+31 QUIT
+32 ;
DATES(IEN,NUM) ; return dates for entry
+1 ; NUM=1 for visit date, =2 for discharge date
+2 NEW X
+3 IF NUM=2
QUIT $$NUMDATE^BDGF($$GET1^DIQ(9009016.1,IEN,.02,"I")\1,1)
+4 ;visit ien
SET X=$$GET1^DIQ(9009016.1,IEN,.03,"I")
IF 'X
QUIT "??"
+5 ;visit date
QUIT $$NUMDATE^BDGF($$GET1^DIQ(9000010,X,.01,"I")\1,1)
+6 ;
WRD(IEN) ; returns ds type or ward
+1 NEW TYPE,X,DATE,CA,PAT
+2 ;visit type
SET TYPE=$$GET1^DIQ(9009016.1,IEN,.0392)
+3 ;I TYPE'["HOS" Q $S(TYPE["DAY":"DS",TYPE["OBS":"DSO",1:"??")
+4 ;IHS/ITSC/LJF 8/9/2004 PATCH #1001
IF TYPE'["HOS"
QUIT $SELECT(TYPE["DAY":"DS",TYPE["OBS":"OBS",1:"??")
+5 ;
+6 ; for inpatients
+7 ;visit
SET V=$$GET1^DIQ(9009016.1,IEN,.03,"I")
+8 ;link to 405
SET X=$ORDER(^DGPM("AVISIT",V,0))
IF 'X
QUIT "??"
+9 ;ward at discharge
QUIT $$GET1^DIQ(405,+$$GET1^DIQ(405,X,.17,"I"),200)
+10 ;
SRV(IEN) ; returns service
+1 QUIT $$GET1^DIQ(45.7,+$$GET1^DIQ(9009016.1,IEN,.04,"I"),99)
+2 ;
CODE(IEN,NUM) ; returns ready to code date and date coded
+1 ; NUM=1 for ready to code; =2 for date coded
+2 NEW X,Y
+3 IF NUM=1
QUIT $$NUMDATE^BDGF($$GET1^DIQ(9009016.1,IEN,.12,"I"),1)
+4 QUIT $$NUMDATE^BDGF($$GET1^DIQ(9009016.1,IEN,.13,"I"),1)
+5 ;
SET(DATA,NUM) ; puts display line into list template array
+1 SET NUM=NUM+1
+2 SET ^TMP("BDGICR1",$JOB,NUM,0)=DATA
+3 QUIT
+4 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("BDGICR1",$JOB)
KILL BDGPRT
+2 QUIT
+3 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
PRINT ; print report to paper
+1 NEW BDGX,BDGLN,BDGPG
+2 ;initialize heading variables
USE IO
DO INIT^BDGF
+3 DO HDG
+4 ;
+5 ; loop thru display array
+6 SET BDGX=0
FOR
SET BDGX=$ORDER(^TMP("BDGICR1",$JOB,BDGX))
IF 'BDGX
QUIT
Begin DoDot:1
+7 IF $Y>(IOSL-4)
DO HDG
+8 SET BDGLN=^TMP("BDGICR1",$JOB,BDGX,0)
+9 WRITE !,BDGLN
End DoDot:1
+10 DO ^%ZISC
DO PRTKL^BDGF
DO EXIT
+11 QUIT
+12 ;
HDG ; heading for paper report
+1 SET BDGPG=$GET(BDGPG)+1
IF BDGPG>1
WRITE @IOF
+2 WRITE !,BDGUSR,?11,"*****",$$CONF^BDGF,"*****"
+3 WRITE !,BDGDATE,?25,"Incomplete Charts by Patient",?70,"Page: ",BDGPG
+4 ;
+5 ;IHS/ITSC/LJF 8/9/2004 PATCH 1001
+6 ;NEW X S X=$S(BDGTYP=1:"Inpatient Charts Only",BDGTYP=2:"Day Surgery Charts Only",1:"Inpatient and Day Surgery Charts")
+7 NEW X
SET X=$SELECT(BDGTYP=1:"Inpatients",BDGTYP=2:"Observations & Day Surgeries",1:"Inpatients, Observations & Day Surgeries")
+8 ;
+9 SET X=X_"("_$PIECE($TEXT(CHOICE+BDGSEL),";;",2)_")"
+10 WRITE !,BDGTIME,?(80-$LENGTH(X)\2),X
+11 ;IHS/ITSC/WAR 7/23/04 PATCH #1001 Next line center printable date range
+12 WRITE !,?(80-$LENGTH(BDGDTS)\2),BDGDTS
+13 WRITE !,$$REPEAT^XLFSTR("-",80)
+14 WRITE !?2,"Patient",?23,"HRCN",?30,"Admt/Dsch",?45,"Ward/Srv",?60
+15 WRITE "Ready/Coded",?81,"Insurance/Unresolved Deficiencies & Comments"
+16 WRITE !,$$REPEAT^XLFSTR("=",80)
+17 QUIT
+18 ;
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 ;
SELECT() ; ask user to choose selected charts
+1 NEW Y,ARRAY,I
+2 WRITE !!
+3 FOR I=1:1:7
SET ARRAY(I)=" "_I_". "_$PIECE($TEXT(CHOICE+I),";;",2)
+4 SET Y=$$READ^BDGF("NO^1:7","Select Charts to Print",1,"","",.ARRAY)
+5 QUIT Y
+6 ;
CHOICE ;;
+1 ;;All Incomplete Charts;;
+2 ;;Charts Not Yet Received;;
+3 ;;Charts Not Yet Tagged;;
+4 ;;Insurance Not Identified;;
+5 ;;Not Coded (Tagged or Not);;
+6 ;;Coded, Not Completed;;
+7 ;;Completed, In Bill Prep;;
