BDGICS1 ; IHS/ANMC/LJF - INPATIENT CODING STATUS ; [ 04/08/2004 4:02 PM ]
;;5.3;PIMS;**1010,1018**;MAY 28, 2004;Build 27
;
;cmi/anch/maw 10/20/2008 PATCH 1010 changed export date field from .14 to 1106
;IHS/OIT/CLS 03/31/2015 PATCH 1018 changed '=' to '[' DAY SURGERY to allow for subspecialties
;
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^BDGICS1","INPT CODING STATUS","BDGBM;BDGEM")
Q
;
;
EN ; -- main entry point for BDG IC CODE STATUS INPT
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 INPT")
D CLEAR^VALM1
Q
;
HDR ; -- 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,($E(BDGEM,1,5)_"00"))
S VALMHDR(3)=$$SP(79-$L(X)\2)_X
Q
;
INIT ; -- 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("BDGICS1",$J),^TMP("BDGICS1A",$J)
S VALMCNT=0
;
; loop through discharges for date range
S DATE=BDGBM,TODAY=DT+.24
F S DATE=$O(^DGPM("AMV3",DATE)) Q:('DATE)!(DATE>BDGEM)!(DATE>TODAY) D
. S MONTH=$E(DATE,1,5)
. S DFN=0 F S DFN=$O(^DGPM("AMV3",DATE,DFN)) Q:'DFN D
.. S IEN=0 F S IEN=$O(^DGPM("AMV3",DATE,DFN,IEN)) Q:'IEN D
... ;
... S ADM=$$GET1^DIQ(405,IEN,.14,"I") ;adm ien
... I $$LASTSRVN^BDGF1(ADM,DFN)["OBSERVATION" Q ;inpt only
... I $$LASTSRVN^BDGF1(ADM,DFN)["DAY SURGERY" Q ;inpt only CHANGED FOR DAY SURGERY IHS/OCAO/CPC - 20140310
... ;IHS/OIT/CLS 03/31/2015 patch 1018
... ;increment # discharged per month
... S COUNT(MONTH,"DSC")=$G(COUNT(MONTH,"DSC"))+1
... ;
... ; check for errors
... S VST=$$GET1^DIQ(405,+ADM,.27,"I") ;visit ien
... I 'VST D ERR("No Visit linked to ADT Admission",IEN,DATE) Q
... I '$D(^AUPNVSIT(VST,0)) D ERR("Linked Visit doesn't exist.",IEN) Q
... I $$GET1^DIQ(9000010,VST,.11)="DELETED" D Q
.... D ERR("ADT Admission linked to Deleted visit.",IEN,DATE)
... ;
... S VH=$O(^AUPNVINP("AD",VST,0)) ;v hosp ien
... I 'VH D ERR("No V Hospitalization for Visit",IEN,DATE) Q
... I '$D(^AUPNVINP(VH,0)) D ERR("No V Hospitalization for Visit.",IEN,DATE) Q
... ; check if uncoded
... I $$GET1^DIQ(9000010.02,VH,.15)="NO" D UNCODED(DATE,IEN) 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 orig line
... I $$GET1^DIQ(9000010,VST,1106)]"" S COUNT(MONTH,"EXP")=$G(COUNT(MONTH,"EXP"))+1 ;cmi/maw 10/20/2008 PATCH 1010 modified for new data export field
;
; build display array
; monthly counts heading
S LINE=$$PAD($$PAD("Month/Year",15)_"# Disch",26)
S LINE=$$PAD($$PAD(LINE_"# Coded",36)_"# Not-Coded",50)
S LINE=$$PAD(LINE_"# Exported",63)_"# 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="DSC","COD","UNC","EXP","ERR" D
.. S LINE=LINE_$J(+$G(COUNT(MON,SUB)),4)_$$SP(8)
. D SET(LINE,.VALMCNT)
;
;IHS/ITSC/LJF 4/8/2004 add totals for each column
D SET($$REPEAT^XLFSTR("=",79),.VALMCNT)
S LINE=$$SP(15)
F SUB="DSC","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)
;IHS/ITSC/LJF 4/8/2004 end of new code
;
D SET("",.VALMCNT)
;
; list uncoded charts
; if any uncoded charts, print heading
I $D(^TMP("BDGICS1A",$J,"U")) D
. S LINE=$$PAD("Admit & Dscharge Dates",24)
. S LINE=$$PAD($$PAD(LINE_"Patient Name",48)_"Chart #",58)
. S LINE=$$PAD(LINE_"Srv",64)_"Insurance"
. D SET("",.VALMCNT),SET(LINE,.VALMCNT)
;
S DSC=0 F S DSC=$O(^TMP("BDGICS1A",$J,"U",DSC)) Q:'DSC D
. S IEN=0 F S IEN=$O(^TMP("BDGICS1A",$J,"U",DSC,IEN)) Q:'IEN D
.. ;
.. S ADM=$$GET1^DIQ(405,IEN,.14,"I") ;adm ien
.. S DFN=$$GET1^DIQ(405,IEN,.03,"I") ;pat ien
.. ;
.. S LINE=$$PAD($$NUMDATE^BDGF(+$G(^DGPM(ADM,0))\1),12) ;adm date
.. S LINE=$$PAD(LINE_$$NUMDATE^BDGF(DSC\1),24) ;dsc date
.. S LINE=$$PAD(LINE_$E($$GET1^DIQ(405,IEN,.03),1,22),48) ;name
.. S LINE=LINE_$J($$HRCN^BDGF2(DFN,DUZ(2)),6)
.. S LINE=$$PAD(LINE,58)_$P($$LASTSRVC^BDGF1(ADM,DFN)," ") ;srv
.. ;
.. ; add insurance coverage
.. S LINE=$$PAD(LINE,64)_$$INSUR^BDGF2(DFN,+^DGPM(ADM,0))
.. D SET(LINE,.VALMCNT)
;
; add error charts to display listing
; if any errors, print heading
I $D(^TMP("BDGICS1A",$J,"E")) D
. I $E(IOST,1,2)="P-" D SET("@@@",.VALMCNT) ;mark errors for paper
. S LINE=$$PAD("Discharge Date",16)_"Patient Name"
. S LINE=$$PAD($$PAD(LINE,38)_"Chart #",48)_"Error Message"
. D SET("",.VALMCNT),SET(LINE,.VALMCNT)
;
S DSC=0 F S DSC=$O(^TMP("BDGICS1A",$J,"E",DSC)) Q:'DSC D
. S IEN=0 F S IEN=$O(^TMP("BDGICS1A",$J,"E",DSC,IEN)) Q:'IEN D
.. ;
.. S DFN=$$GET1^DIQ(405,IEN,.03,"I") ;pat ien
.. S LINE=$$PAD($$NUMDATE^BDGF(DSC\1),16) ;dsc date
.. S LINE=$$PAD(LINE_$E($$GET1^DIQ(405,IEN,.03),1,18),38) ;name
.. S LINE=LINE_$J($$HRCN^BDGF2(DFN,DUZ(2)),6) ;chart #
.. S LINE=$$PAD(LINE,48)_^TMP("BDGICS1A",$J,"E",DSC,IEN) ;err msg
.. D SET(LINE,.VALMCNT)
;
I '$D(^TMP("BDGICS1",$J)) D SET("NO DATA FOUND",.VALMCNT)
K ^TMP("BDGICS1A",$J)
Q
;
ERR(MSG,IEN,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("BDGICS1A",$J,"E",DATE,IEN)=MSG
Q
;
UNCODED(DATE,IEN) ; 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("BDGICS1A",$J,"U",DATE,IEN)=""
Q
;
SET(DATA,NUM) ; put data line into display array
S NUM=NUM+1
S ^TMP("BDGICS1",$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("BDGICS1",$J,BDGL)) Q:'BDGL D
. I ^TMP("BDGICS1",$J,BDGL,0)="@@@" S FIRST=1 Q ;beginning of errors
. I $Y>(IOSL-4) D HDG
. W !,^TMP("BDGICS1",$J,BDGL,0)
D ^%ZISC,EXIT
Q
;
HDG ; heading when printing to paper
;W @IOF W !?20,"INPATIENT CODING STATUS REPORT"
I 'FIRST W @IOF ;IHS/ITSC/LJF 1/15/2004
W !?20,"INPATIENT CODING STATUS REPORT" ;IHS/ITSC/LJF 1/15/2004
D HDR F I=1:1 Q:'$D(VALMHDR(I)) W !,VALMHDR(I)
I FIRST W !,$$REPEAT^XLFSTR("=",80),! S FIRST=0 Q
W !,"Discharge/Admit Dates",?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("BDGICS1",$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)
BDGICS1 ; IHS/ANMC/LJF - INPATIENT CODING STATUS ; [ 04/08/2004 4:02 PM ]
+1 ;;5.3;PIMS;**1010,1018**;MAY 28, 2004;Build 27
+2 ;
+3 ;cmi/anch/maw 10/20/2008 PATCH 1010 changed export date field from .14 to 1106
+4 ;IHS/OIT/CLS 03/31/2015 PATCH 1018 changed '=' to '[' DAY SURGERY to allow for subspecialties
+5 ;
+6 NEW BDGBM,BDGEM
+7 SET BDGBM=$$READ^BDGF("DO^::EP","Select Beginning Month")
IF BDGBM<1
QUIT
+8 SET BDGEM=$$READ^BDGF("DO^::EP","Select Ending Month")
IF BDGEM<1
QUIT
+9 SET BDGBM=$EXTRACT(BDGBM,1,5)_"00"
SET BDGEM=$EXTRACT(BDGEM,1,5)_"31.24"
+10 ;
+11 DO ZIS^BDGF("PQ","EN^BDGICS1","INPT CODING STATUS","BDGBM;BDGEM")
+12 QUIT
+13 ;
+14 ;
EN ; -- main entry point for BDG IC CODE STATUS INPT
+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 INPT")
+5 DO CLEAR^VALM1
+6 QUIT
+7 ;
HDR ; -- 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,($EXTRACT(BDGEM,1,5)_"00"))
+5 SET VALMHDR(3)=$$SP(79-$LENGTH(X)\2)_X
+6 QUIT
+7 ;
INIT ; -- 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("BDGICS1",$JOB),^TMP("BDGICS1A",$JOB)
+4 SET VALMCNT=0
+5 ;
+6 ; loop through discharges for date range
+7 SET DATE=BDGBM
SET TODAY=DT+.24
+8 FOR
SET DATE=$ORDER(^DGPM("AMV3",DATE))
IF ('DATE)!(DATE>BDGEM)!(DATE>TODAY)
QUIT
Begin DoDot:1
+9 SET MONTH=$EXTRACT(DATE,1,5)
+10 SET DFN=0
FOR
SET DFN=$ORDER(^DGPM("AMV3",DATE,DFN))
IF 'DFN
QUIT
Begin DoDot:2
+11 SET IEN=0
FOR
SET IEN=$ORDER(^DGPM("AMV3",DATE,DFN,IEN))
IF 'IEN
QUIT
Begin DoDot:3
+12 ;
+13 ;adm ien
SET ADM=$$GET1^DIQ(405,IEN,.14,"I")
+14 ;inpt only
IF $$LASTSRVN^BDGF1(ADM,DFN)["OBSERVATION"
QUIT
+15 ;inpt only CHANGED FOR DAY SURGERY IHS/OCAO/CPC - 20140310
IF $$LASTSRVN^BDGF1(ADM,DFN)["DAY SURGERY"
QUIT
+16 ;IHS/OIT/CLS 03/31/2015 patch 1018
+17 ;increment # discharged per month
+18 SET COUNT(MONTH,"DSC")=$GET(COUNT(MONTH,"DSC"))+1
+19 ;
+20 ; check for errors
+21 ;visit ien
SET VST=$$GET1^DIQ(405,+ADM,.27,"I")
+22 IF 'VST
DO ERR("No Visit linked to ADT Admission",IEN,DATE)
QUIT
+23 IF '$DATA(^AUPNVSIT(VST,0))
DO ERR("Linked Visit doesn't exist.",IEN)
QUIT
+24 IF $$GET1^DIQ(9000010,VST,.11)="DELETED"
Begin DoDot:4
+25 DO ERR("ADT Admission linked to Deleted visit.",IEN,DATE)
End DoDot:4
QUIT
+26 ;
+27 ;v hosp ien
SET VH=$ORDER(^AUPNVINP("AD",VST,0))
+28 IF 'VH
DO ERR("No V Hospitalization for Visit",IEN,DATE)
QUIT
+29 IF '$DATA(^AUPNVINP(VH,0))
DO ERR("No V Hospitalization for Visit.",IEN,DATE)
QUIT
+30 ; check if uncoded
+31 IF $$GET1^DIQ(9000010.02,VH,.15)="NO"
DO UNCODED(DATE,IEN)
QUIT
+32 ;
+33 ; check if exported
+34 SET COUNT(MONTH,"COD")=$GET(COUNT(MONTH,"COD"))+1
+35 ;I $$GET1^DIQ(9000010,VST,.14)]"" S COUNT(MONTH,"EXP")=$G(COUNT(MONTH,"EXP"))+1 ;cmi/maw 10/20/2008 orig line
+36 ;cmi/maw 10/20/2008 PATCH 1010 modified for new data export field
IF $$GET1^DIQ(9000010,VST,1106)]""
SET COUNT(MONTH,"EXP")=$GET(COUNT(MONTH,"EXP"))+1
End DoDot:3
End DoDot:2
End DoDot:1
+37 ;
+38 ; build display array
+39 ; monthly counts heading
+40 SET LINE=$$PAD($$PAD("Month/Year",15)_"# Disch",26)
+41 SET LINE=$$PAD($$PAD(LINE_"# Coded",36)_"# Not-Coded",50)
+42 SET LINE=$$PAD(LINE_"# Exported",63)_"# Errors"
+43 DO SET(LINE,.VALMCNT)
+44 ; monthly counts
+45 SET MON=0
FOR
SET MON=$ORDER(COUNT(MON))
IF 'MON
QUIT
Begin DoDot:1
+46 SET LINE=$$PAD($$FMTE^XLFDT(MON_"00"),15)
+47 FOR SUB="DSC","COD","UNC","EXP","ERR"
Begin DoDot:2
+48 SET LINE=LINE_$JUSTIFY(+$GET(COUNT(MON,SUB)),4)_$$SP(8)
End DoDot:2
+49 DO SET(LINE,.VALMCNT)
End DoDot:1
+50 ;
+51 ;IHS/ITSC/LJF 4/8/2004 add totals for each column
+52 DO SET($$REPEAT^XLFSTR("=",79),.VALMCNT)
+53 SET LINE=$$SP(15)
+54 FOR SUB="DSC","COD","UNC","EXP","ERR"
Begin DoDot:1
+55 SET TOTAL=0
SET MON=0
+56 FOR
SET MON=$ORDER(COUNT(MON))
IF 'MON
QUIT
SET TOTAL=$GET(TOTAL)+$GET(COUNT(MON,SUB))
+57 SET LINE=LINE_$JUSTIFY(TOTAL,4)_$$SP(8)
End DoDot:1
+58 DO SET(LINE,.VALMCNT)
+59 ;IHS/ITSC/LJF 4/8/2004 end of new code
+60 ;
+61 DO SET("",.VALMCNT)
+62 ;
+63 ; list uncoded charts
+64 ; if any uncoded charts, print heading
+65 IF $DATA(^TMP("BDGICS1A",$JOB,"U"))
Begin DoDot:1
+66 SET LINE=$$PAD("Admit & Dscharge Dates",24)
+67 SET LINE=$$PAD($$PAD(LINE_"Patient Name",48)_"Chart #",58)
+68 SET LINE=$$PAD(LINE_"Srv",64)_"Insurance"
+69 DO SET("",.VALMCNT)
DO SET(LINE,.VALMCNT)
End DoDot:1
+70 ;
+71 SET DSC=0
FOR
SET DSC=$ORDER(^TMP("BDGICS1A",$JOB,"U",DSC))
IF 'DSC
QUIT
Begin DoDot:1
+72 SET IEN=0
FOR
SET IEN=$ORDER(^TMP("BDGICS1A",$JOB,"U",DSC,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+73 ;
+74 ;adm ien
SET ADM=$$GET1^DIQ(405,IEN,.14,"I")
+75 ;pat ien
SET DFN=$$GET1^DIQ(405,IEN,.03,"I")
+76 ;
+77 ;adm date
SET LINE=$$PAD($$NUMDATE^BDGF(+$GET(^DGPM(ADM,0))\1),12)
+78 ;dsc date
SET LINE=$$PAD(LINE_$$NUMDATE^BDGF(DSC\1),24)
+79 ;name
SET LINE=$$PAD(LINE_$EXTRACT($$GET1^DIQ(405,IEN,.03),1,22),48)
+80 SET LINE=LINE_$JUSTIFY($$HRCN^BDGF2(DFN,DUZ(2)),6)
+81 ;srv
SET LINE=$$PAD(LINE,58)_$PIECE($$LASTSRVC^BDGF1(ADM,DFN)," ")
+82 ;
+83 ; add insurance coverage
+84 SET LINE=$$PAD(LINE,64)_$$INSUR^BDGF2(DFN,+^DGPM(ADM,0))
+85 DO SET(LINE,.VALMCNT)
End DoDot:2
End DoDot:1
+86 ;
+87 ; add error charts to display listing
+88 ; if any errors, print heading
+89 IF $DATA(^TMP("BDGICS1A",$JOB,"E"))
Begin DoDot:1
+90 ;mark errors for paper
IF $EXTRACT(IOST,1,2)="P-"
DO SET("@@@",.VALMCNT)
+91 SET LINE=$$PAD("Discharge Date",16)_"Patient Name"
+92 SET LINE=$$PAD($$PAD(LINE,38)_"Chart #",48)_"Error Message"
+93 DO SET("",.VALMCNT)
DO SET(LINE,.VALMCNT)
End DoDot:1
+94 ;
+95 SET DSC=0
FOR
SET DSC=$ORDER(^TMP("BDGICS1A",$JOB,"E",DSC))
IF 'DSC
QUIT
Begin DoDot:1
+96 SET IEN=0
FOR
SET IEN=$ORDER(^TMP("BDGICS1A",$JOB,"E",DSC,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+97 ;
+98 ;pat ien
SET DFN=$$GET1^DIQ(405,IEN,.03,"I")
+99 ;dsc date
SET LINE=$$PAD($$NUMDATE^BDGF(DSC\1),16)
+100 ;name
SET LINE=$$PAD(LINE_$EXTRACT($$GET1^DIQ(405,IEN,.03),1,18),38)
+101 ;chart #
SET LINE=LINE_$JUSTIFY($$HRCN^BDGF2(DFN,DUZ(2)),6)
+102 ;err msg
SET LINE=$$PAD(LINE,48)_^TMP("BDGICS1A",$JOB,"E",DSC,IEN)
+103 DO SET(LINE,.VALMCNT)
End DoDot:2
End DoDot:1
+104 ;
+105 IF '$DATA(^TMP("BDGICS1",$JOB))
DO SET("NO DATA FOUND",.VALMCNT)
+106 KILL ^TMP("BDGICS1A",$JOB)
+107 QUIT
+108 ;
ERR(MSG,IEN,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("BDGICS1A",$JOB,"E",DATE,IEN)=MSG
+5 QUIT
+6 ;
UNCODED(DATE,IEN) ; 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("BDGICS1A",$JOB,"U",DATE,IEN)=""
+5 QUIT
+6 ;
SET(DATA,NUM) ; put data line into display array
+1 SET NUM=NUM+1
+2 SET ^TMP("BDGICS1",$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("BDGICS1",$JOB,BDGL))
IF 'BDGL
QUIT
Begin DoDot:1
+4 ;beginning of errors
IF ^TMP("BDGICS1",$JOB,BDGL,0)="@@@"
SET FIRST=1
QUIT
+5 IF $Y>(IOSL-4)
DO HDG
+6 WRITE !,^TMP("BDGICS1",$JOB,BDGL,0)
End DoDot:1
+7 DO ^%ZISC
DO EXIT
+8 QUIT
+9 ;
HDG ; heading when printing to paper
+1 ;W @IOF W !?20,"INPATIENT CODING STATUS REPORT"
+2 ;IHS/ITSC/LJF 1/15/2004
IF 'FIRST
WRITE @IOF
+3 ;IHS/ITSC/LJF 1/15/2004
WRITE !?20,"INPATIENT CODING STATUS REPORT"
+4 DO HDR
FOR I=1:1
IF '$DATA(VALMHDR(I))
QUIT
WRITE !,VALMHDR(I)
+5 IF FIRST
WRITE !,$$REPEAT^XLFSTR("=",80),!
SET FIRST=0
QUIT
+6 WRITE !,"Discharge/Admit Dates",?24,"Patient Name",?44,"Chart #"
+7 WRITE !?54,"Serv",?60,"Insurance",!,$$REPEAT^XLFSTR("=",80),!
+8 QUIT
+9 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("BDGICS1",$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)
