168 lines
5.6 KiB
Mathematica
168 lines
5.6 KiB
Mathematica
|
IBDFOSG2 ;ALB/TMP - ENCOUNTERS WITH BILLING DATA CONT. - SEP 11, 1995
|
||
|
|
;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
|
||
|
|
TOT2 ; #2a,b
|
||
|
|
N IBDHD,IBBY,IBFLDS
|
||
|
|
I '$D(DT) D DT^DICRW
|
||
|
|
S (IBFLDS,IBBY)="OPT AMT BILLED & # GEN"
|
||
|
|
S IBDHD="(#2a,2b) OUTPT DOLLARS BILLED, # OF OUTPT BILLS GENERATED"
|
||
|
|
D PRT("2a,b",IBFLDS,IBBY,IBDHD)
|
||
|
|
K IOP,DQTIME
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
TOT3 ; #3a,b
|
||
|
|
N IBDHD,IBBY,IBFLDS
|
||
|
|
I '$D(DT) D DT^DICRW
|
||
|
|
S (IBFLDS,IBBY)="OPT NUM BILLS GEN < 65"
|
||
|
|
S IBDHD="(#3a) # OF OUTPT BILLS FOR PATIENTS < 65 YEARS OF AGE DATE: "
|
||
|
|
D PRT("3a",IBFLDS,IBBY,IBDHD)
|
||
|
|
;
|
||
|
|
I '$D(IOP) W !,"#3b" D SELDEV Q:'$D(IOP)!('$D(DQTIME))
|
||
|
|
S (IBFLDS,IBBY)="OPT NUM BILLS GEN 65 & UP"
|
||
|
|
S IBDHD="(#3b) # OF OUTPT BILLS FOR PATIENTS AGE 65 AND OVER"
|
||
|
|
D PRT("3b",IBFLDS,IBBY,IBDHD)
|
||
|
|
K IOP,DQTIME
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
TOT4 ; #4
|
||
|
|
N IBDHD,IBBY,IBFLDS
|
||
|
|
I '$D(DT) D DT^DICRW
|
||
|
|
S (IBFLDS,IBBY)="OPT # BILLS GEN < 30 DYS"
|
||
|
|
S IBDHD="(#4) # BILLS GENERATED < 30 DAYS FROM DT OF SERVICE"
|
||
|
|
D PRT(4,IBFLDS,IBBY,IBDHD)
|
||
|
|
K IOP,DQTIME
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
TOT7 ; #7
|
||
|
|
N IBDHD,IBBY,IBFLDS
|
||
|
|
I '$D(DT) D DT^DICRW
|
||
|
|
S (IBFLDS,IBBY)="CPT CODE - MNTH OPT BILLS"
|
||
|
|
S IBDHD="(#7) TOTAL # CPT CODES ON OUTPATIENT BILLS FOR A MONTH"
|
||
|
|
D PRT(7,IBFLDS,IBBY,IBDHD)
|
||
|
|
K IOP,DQTIME
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
TOT10 ; #10a,b
|
||
|
|
N IBDHD,IBBY,IBFLDS
|
||
|
|
I '$D(DT) D DT^DICRW
|
||
|
|
S (IBFLDS,IBBY)="LAG ENC DT TO CREAT & PRT"
|
||
|
|
S IBDHD="(#10a,10b) AVG LAG FROM ENC DATE TO CREATE AND PRINT DATES"
|
||
|
|
D PRT(10,IBFLDS,IBBY,IBDHD)
|
||
|
|
K IOP,DQTIME
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
TOT11 ; #11
|
||
|
|
N DTRNG,DTRNG1
|
||
|
|
I '$D(DT) D DT^DICRW
|
||
|
|
D END
|
||
|
|
W !,"#11"
|
||
|
|
W !!,"Scanned Encounter Forms with Outpatient Bills Generated."
|
||
|
|
;I $D(^DG(43,1,"GL")) S IBDFMUL=$P(^DG(43,1,"GL"),"^",2)
|
||
|
|
;I $D(IBDFMUL),IBDFMUL D DIVISION^VAUTOMA I Y=-1 G END
|
||
|
|
;I 'IBDFMUL S IBDFDV=$O(^DG(40.8,0))
|
||
|
|
S (VAUTD,IBDFMUL)=1
|
||
|
|
;
|
||
|
|
W !!,"You will need a 132 column printer for this report!",!
|
||
|
|
D SELDEV I '$D(IOP)!('$D(DQTIME)) G END
|
||
|
|
;
|
||
|
|
D DTRNG ;,SELMONTH
|
||
|
|
S IBZ=$G(DTRNG1($E(Y,1,5)_"01"))
|
||
|
|
I IBZ,$D(DTRNG(IBZ)) S IBBDT=$P(DTRNG(IBZ),U),IBEDT=$P(DTRNG(IBZ),U,2) D PRT11
|
||
|
|
S DIR(0)="SB^A:ALL 24 MONTHS;S:SELECTED MONTH ONLY",DIR("A")="INCLUDE ALL MONTHS OR A SELECTED MONTH",DIR("B")="A" D ^DIR K DIR
|
||
|
|
G:$D(DIRUT) TOT11Q
|
||
|
|
I Y="A" D G TOT11Q
|
||
|
|
.F IBZ=1:1:24 D PRT11
|
||
|
|
D SELMONTH
|
||
|
|
S IBZ=$G(DTRNG1($E(Y,1,5)_"01")) I IBZ D PRT11
|
||
|
|
;
|
||
|
|
TOT11Q G END
|
||
|
|
;
|
||
|
|
PRT11 ;
|
||
|
|
I IBZ,$D(DTRNG(IBZ)) S IBBDT=$P(DTRNG(IBZ),U),IBEDT=$P(DTRNG(IBZ),U,2)
|
||
|
|
S DIPA("DTFR")=IBBDT
|
||
|
|
W !,"#11 MONTH: "_$$DT()
|
||
|
|
S IBDFL="CLN",VAUTC=1
|
||
|
|
S IBDFDAT=$$HTE^XLFDT($H)
|
||
|
|
S IBDFBEG=IBBDT,IBDFEND=IBEDT
|
||
|
|
S ZTDTH=$TR(DQTIME,"@",".")
|
||
|
|
S ZTRTN="DQ^IBDFOSG",ZTSAVE("IB*")="",ZTSAVE("VAU*")="",ZTSAVE("VAD*")="",ZTDESC="Scanned Encntr Forms Totals" D ^%ZTLOAD
|
||
|
|
W !,$S($D(ZTSK):"Request Queued Task="_ZTSK,1:"Request Canceled")
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
END D END^IBDFOSG
|
||
|
|
K DQTIME,IOP
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
PRT(IBTOT,IBFLDS,IBBY,IBDHD,DIOBEG,DIOEND) ; Prt rpt
|
||
|
|
N IBZ,DTRNG,DTRNG1,DIPA,Y,X
|
||
|
|
W !,"#",IBTOT
|
||
|
|
D:'$D(IOP) SELDEV G:'$D(IOP)!('$D(DQTIME)) PRTQ
|
||
|
|
D DTRNG
|
||
|
|
S DIR(0)="SB^A:ALL 24 MONTHS;S:SELECTED MONTH ONLY",DIR("A")="INCLUDE ALL MONTHS OR A SELECTED MONTH",DIR("B")="A" D ^DIR K DIR
|
||
|
|
G:$D(DIRUT) PRTQ
|
||
|
|
I Y="A" D G PRTQ
|
||
|
|
.F IBZ=1:1:24 D PRT1
|
||
|
|
D SELMONTH
|
||
|
|
S IBZ=$G(DTRNG1($E(Y,1,5)_"01")) I IBZ D PRT1
|
||
|
|
PRTQ Q
|
||
|
|
;
|
||
|
|
PRT1 I $G(IBTOT)=10 S DIOBEG="D BEG10^IBDFOSG2",DIOEND="D END10^IBDFOSG2"
|
||
|
|
S DIPA("DTTO")=$P(DTRNG(IBZ),U,2),DIPA("DTFR")=$P(DTRNG(IBZ),U),FLDS="[EFDP "_IBFLDS_"]",BY="[EFDP "_IBBY_"]"
|
||
|
|
S FR="3,"_DIPA("DTFR"),TO="4,"_DIPA("DTTO"),L=0,DHD=IBDHD_" MONTH: "_$$DT(),DIC="^DGCR(399,",DIS(0)="I $O(^DGCR(399,D0,""OP"",0))'="""""
|
||
|
|
W !,"TOTALS FOR #"_IBTOT_" ("_$$DT()_")"
|
||
|
|
D EN1^DIP
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
BEG10 ; DIOBEG
|
||
|
|
S ^TMP($J,"EFDPTOT",1)=0,^(2)=0,^TMP($J,"EFDPTOT",3)=0,^(4)=0
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
END10 ; DIOEND
|
||
|
|
W !!,"(10a) AVERAGE # DAYS LAG FROM ENCOUNTER TO BILL CREATE: ",$J($S(^TMP($J,"EFDPTOT",2):^TMP($J,"EFDPTOT",1)/^TMP($J,"EFDPTOT",2),1:0),10,2)
|
||
|
|
W !,"(10b) AVERAGE # DAYS LAG FROM ENCOUNTER TO BILL PRINT : ",$J($S(^TMP($J,"EFDPTOT",4):^TMP($J,"EFDPTOT",3)/^TMP($J,"EFDPTOT",4),1:0),10,2)
|
||
|
|
K ^TMP($J,"EFDPTOT")
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
LAG ; Set up lag time accumulators-from computed fld
|
||
|
|
N X1,X2,Z,Z0,Z1
|
||
|
|
S (Z,X)=0,Z0=+$G(^DGCR(399,D0,"S")),Z1=+$P($G(^("S")),U,12)
|
||
|
|
F S Z=$O(^DGCR(399,D0,"OP",Z)) S:'Z X=0 Q:'Z D ;loop thru opt visits
|
||
|
|
.S X1=Z0,X2=+$G(^DGCR(399,D0,"OP",Z,0)) I X2,X1 D ^%DTC S ^TMP($J,"EFDPTOT",1)=$G(^TMP($J,"EFDPTOT",1))+X,^TMP($J,"EFDPTOT",2)=$G(^TMP($J,"EFDPTOT",2))+1 ;elapsed time and count - encounter to bill create
|
||
|
|
.S X1=Z1,X2=+$G(^DGCR(399,D0,"OP",Z,0)) I X2,X1 D ^%DTC S ^TMP($J,"EFDPTOT",3)=$G(^TMP($J,"EFDPTOT",3))+X,^TMP($J,"EFDPTOT",4)=$G(^TMP($J,"EFDPTOT",4))+1 ;elapsed tm,ct (encntr-bill 1st prt)
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
GEN30 ; Was printed within 30 days of any visit on bill
|
||
|
|
N X1,X2,Z,Z0
|
||
|
|
S (Z,X)=0,Z0=+$P($G(^DGCR(399,D0,"S")),U,12) Q:'Z0
|
||
|
|
F S Z=$O(^DGCR(399,D0,"OP",Z)) S:'Z X=0 Q:'Z D Q:X ;loop thru opt visits
|
||
|
|
.S X1=Z0,X2=+$G(^DGCR(399,D0,"OP",Z,0)) I X2,X1 D ^%DTC S X=$S(X<30:1,1:0)
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
DTRNG ;
|
||
|
|
N Z,Z0,X1,X2,X
|
||
|
|
;S Z=2931001 F Z0=1:1:23 D
|
||
|
|
S Z=2940401 F Z0=1:1:24 D
|
||
|
|
.S X2=-1,Z1=$E(Z,1,5)+1_"01" S:$E(Z1,4,5)=13 Z1=Z1+8800
|
||
|
|
.S X1=Z1 D C^%DTC S DTRNG(Z0)=Z_U_X,DTRNG1(Z)=Z0,Z=Z1
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
SELDEV ; Device/queue tm (IOP,DQTIME returned)
|
||
|
|
K IOP,DQTIME
|
||
|
|
S %ZIS("A")="Select device the output will be queued to: ",%ZIS="NQ",%ZIS("B")=""
|
||
|
|
D ^%ZIS K %ZIS
|
||
|
|
I IO=IO(0) W !,$C(7),"CANNOT BE YOUR HOME DEVICE" G SELDEV
|
||
|
|
I POP D HOME^%ZIS G SELDEVQ
|
||
|
|
S IOP="Q;"_IO
|
||
|
|
S %DT("A")="Select date/time to queue these reports to run: ",%DT="AEXRF",%DT("B")="NOW",%DT(0)="NOW" D ^%DT K %DT
|
||
|
|
I Y>0 S DQTIME=$TR(Y,".","@") I $L($P(Y,"@",2))<4 S DQTIME=DQTIME_$E("0000",1,4-$L($P(DQTIME,"@",2)))
|
||
|
|
SELDEVQ Q
|
||
|
|
;
|
||
|
|
DT() ; Display date format
|
||
|
|
S Y=$E(DIPA("DTFR"),1,5)_"00"
|
||
|
|
D DD^%DT
|
||
|
|
Q Y
|
||
|
|
;
|
||
|
|
SELMONTH ;
|
||
|
|
F S %DT="AEPN",%DT(0)=-2960300,%DT("A")="SELECT MONTH: " D ^%DT K %DT Q:X="^"!($D(DTOUT))!($D(DTRNG1($E(Y,1,5)_"01"))) W !,$C(7),"Must choose a month from 4/94 thru 3/96"
|
||
|
|
Q
|
||
|
|
;
|