Routine: BDGICR1

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")

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

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

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)

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

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

HELP ; -- help code

 S X="?" D DISP^XQORM1 W !!

EXIT ; -- exit code

 K ^TMP("BDGICR1",$J) K BDGPRT

EXPND ; -- expand code

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

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)

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;;

BDGICR1.m