110 lines
6.0 KiB
Mathematica
110 lines
6.0 KiB
Mathematica
SCRPW14 ;RENO/KEITH - Encounter Activity Report ;06/10/99
|
|
;;5.3;Scheduling;**139,144,180**;AUG 13, 1993
|
|
;06/10/99 ACS Added cpt modifiers to the report
|
|
;
|
|
N DIC,DIR,DTOUT,DUOUT,X,Y,SD,ZTSAVE,%DT,SDDIV,SDI
|
|
D TITL^SCRPW50("Encounter Activity Report") G:'$$DIVA^SCRPW17(.SDDIV) EXIT
|
|
D SUBT^SCRPW50("*** Date Range Selection ***")
|
|
FDT W ! S %DT="AEPX",%DT("A")="Beginning date: ",%DT(0)="-TODAY" D ^%DT G:X=U!$D(DTOUT)!(X="") EXIT
|
|
G:Y<1 FDT S SD("BDT")=Y X ^DD("DD") S SD("PBDT")=Y W !
|
|
LDT S %DT("A")="Ending date: " D ^%DT G:X=U!$D(DTOUT)!(X="") EXIT
|
|
I Y<SD("BDT") W !!,$C(7),"Ending date must be after beginning date!",! G LDT
|
|
G:Y<1 LDT S SD("EDT")=Y X ^DD("DD") S SD("PEDT")=Y,SD("EDT")=SD("EDT")_".999999"
|
|
CATE D SUBT^SCRPW50("*** Report Category Selection ***")
|
|
W ! S DIR(0)="S^C:CLINIC;P:PROVIDER;S:STOP CODE",DIR("A")="Select category for report output" D ^DIR G:$D(DTOUT)!$D(DUOUT) EXIT S SD("CAT")=Y D STAT G:'$D(SD("STAT")) EXIT
|
|
D SUBT^SCRPW50("*** Report Format Selection ***")
|
|
W ! S DIR(0)="S^D:DETAILED;S:SUMMARY",DIR("A")="Select report format",DIR("B")="SUMMARY" D ^DIR G:$D(DTOUT)!$D(DUOUT) EXIT S SD("FMT")=Y
|
|
I SD("FMT")="S" W ! S DIR(0)="S^A:ALPHABETIC;E:ENCOUNTER TOTALS;V:VISIT TOTALS;U:UNIQUE TOTALS",DIR("A")="Select report order",DIR("B")="ALPHABETIC" D ^DIR G:$D(DTOUT)!$D(DUOUT) EXIT S SD("ORD")=Y G QUE
|
|
S SD("ORD")="A" D LIST(SD("CAT")) G:'$D(SD("LIST")) EXIT
|
|
QUE D SUBT^SCRPW50("*** Selected Report Parameters ***")
|
|
W !!,"You have selected the following report parameters:",! D PVIEW^SCRPW15(0)
|
|
W ! K DIR S DIR(0)="Y",DIR("A")="OK",DIR("B")="YES" D ^DIR G:$D(DTOUT)!$D(DUOUT) EXIT G:'Y EXIT
|
|
F SDI="SDDIV","SDDIV(","SD(","SDL(" S ZTSAVE(SDI)=""
|
|
W ! D EN^XUTMDEVQ("RPT^SCRPW14","OPT. ACTIVITY REPORT",.ZTSAVE)
|
|
;
|
|
EXIT D END^SCRPW50 Q
|
|
;
|
|
STAT ;Prompt for encounter statuses to include
|
|
D SUBT^SCRPW50("*** Encounter Status Selection ***")
|
|
K SD("STAT") W !!,"Choose as many of the following statuses",!,"as you wish to include in the report:",!
|
|
W !?10,"CHECKED IN",!?10,"CHECKED OUT",!?10,"NO ACTION TAKEN",!?10,"INPATIENT APPOINTMENT",!?10,"NON-COUNT",!?10,"ACTION REQUIRED",! N DIC,I S DIC="^SD(409.63,",DIC(0)="AEMQ",DIC("B")="CHECKED OUT"
|
|
S DIC("S")="I Y<4!(Y=8!(Y=12!(Y=14)))",DIC("A")="Select encounter status: " F I=1:1 D ^DIC Q:$D(DTOUT)!$D(DUOUT) S:Y>0 SD("STAT",$P(Y,U))="" K DIC("B") Q:X=""&(I>1)
|
|
Q
|
|
;
|
|
LIST(X) ;Get list for detail
|
|
;Output: SD("LIST",ifn)=name
|
|
W ! N DIC S DIC=$S(X="C":"^SC(",X="P":"^VA(200,",1:"^DIC(40.7,"),DIC(0)="AEMQ" S:X="S" DIC("S")="I $L($P(^(0),U,2))=3"
|
|
F D ^DIC Q:$D(DTOUT)!$D(DUOUT)!(X="") S:Y>0 SD("LIST",$P(Y,U))=$P(Y,U,2)
|
|
W ! Q
|
|
;
|
|
RPT ;Print report
|
|
N %,X,Y,SDQ,SDTIT,SDI,DFN,SDIVN,SDMD,SDOUT,SDSTOP,SDX
|
|
N SDCH,SDCH0,SDCL,SDCOL,SDD,SDD0,SDDET,SDDT,SDFFS,SDLINE,SDN,SDOE,SDOE0,SDOED,SDOED0,SDP,SDPI,SDP0,SDPAGE,SDPG,SDPNOW,SDPR,SDPT,SDR,SDS,SDSC,SDSV,SDT,SDT1,SDT2,SDTOT,SDTOT1,SDTOT2,SDUN,SDVP,SDVP0,SDVS,SDLIST,SDRPVS,SDRPUN,SDRPEN
|
|
K ^TMP("SCRPW",$J) S (SDOUT,SDSTOP)=0,SDMD=$O(SDDIV("")),SDMD=$O(SDDIV(SDMD)) S:$P(SDDIV,U,2)="ALL DIVISIONS" SDMD=1
|
|
S SDDT=SD("BDT") F S SDDT=$O(^SCE("B",SDDT)) Q:'SDDT!(SDDT>SD("EDT"))!SDOUT S SDOE=0 F S SDOE=$O(^SCE("B",SDDT,SDOE)) Q:'SDOE!SDOUT S SDOE0=$$GETOE^SDOE(SDOE) I $L(SDOE0) S SDIV=$P(SDOE0,U,11) D:SDIV EVAL
|
|
G:SDOUT EXIT G ^SCRPW15
|
|
;
|
|
STOP ;Check for stop task request
|
|
S:$G(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
|
|
;
|
|
EVAL ;Evaluate encounter
|
|
S SDSTOP=SDSTOP+1 I SDSTOP#3000=0 D STOP Q:SDOUT
|
|
I '$P(SDOE0,U,6),$$DIV(SDIV),$D(SD("STAT",+$P(SDOE0,U,12))) K SDS I $$CAT(.SDS) D SRT(SDIV) D:SDMD SRT(0) S SDS=0 F S SDS=$O(SDS(SDS)) Q:'SDS D SET
|
|
Q
|
|
;
|
|
DIV(SDIV) ;Evaluate division
|
|
Q:'SDDIV 1 Q $D(SDDIV(SDIV))
|
|
;
|
|
SRT(SDIV) ;Set report total for summary format
|
|
Q:SD("FMT")="D" S SDRPEN(SDIV)=$G(SDRPEN(SDIV))+1,^TMP("SCRPW",$J,SDIV,"RPT","PT",+$P(SDOE0,U,2),+$P(SDDT,"."))="" Q
|
|
;
|
|
SET ;Set global for a division
|
|
D SET1(SDIV) D:SDMD SET1(0) Q:SD("FMT")="S"
|
|
K SDLIST D GETDX^SDOE(SDOE,"SDLIST")
|
|
S SDOED=0 F S SDOED=$O(SDLIST(SDOED)) Q:'SDOED S SDOED0=SDLIST(SDOED) D:$L(SDOED0) DSET(SDIV) D:SDMD DSET(0)
|
|
K SDLIST D GETCPT^SDOE(SDOE,"SDLIST")
|
|
S SDVP=0 F S SDVP=$O(SDLIST(SDVP)) Q:'SDVP S SDVP0=SDLIST(SDVP) I $L(SDVP0) D PSET(SDIV) D:SDMD PSET(0)
|
|
Q
|
|
;
|
|
SET1(SDIV) S ^TMP("SCRPW",$J,SDIV,1,SDS,"ENC")=$G(^TMP("SCRPW",$J,SDIV,1,SDS,"ENC"))+1,^TMP("SCRPW",$J,SDIV,1,SDS,"PT",+$P(SDOE0,U,2),+$P(SDDT,"."))=""
|
|
Q
|
|
;
|
|
DSET(SDIV) S SDD=+$P(SDOED0,U),SDR=$S($P(SDOED0,U,12)="P":"PRI",1:"SEC"),^TMP("SCRPW",$J,SDIV,1,SDS,"DX",SDD,SDR)=$G(^TMP("SCRPW",$J,SDIV,1,SDS,"DX",SDD,SDR))+1 Q
|
|
;
|
|
PSET(SDIV) ;
|
|
I SD("CAT")="P",'$$OLD^SDOEUT(SDOE) S SDPR=$P($G(^AUPNVCPT(SDVP,12)),U,4) Q:'$D(SD("LIST",+SDPR))
|
|
;S SDP=+$P(SDVP0,U),SDQ=$P(SDVP0,U,16) S:'SDQ SDQ=1 S ^TMP("SCRPW",$J,SDIV,1,SDS,"PROC",SDP)=$G(^TMP("SCRPW",$J,SDIV,1,SDS,"PROC",SDP))+SDQ Q
|
|
;SDP=procedure pointer, SDQ=procedure quantity
|
|
S SDP=+$P(SDVP0,U)
|
|
S SDQ=$P(SDVP0,U,16)
|
|
S:'SDQ SDQ=1
|
|
; add quantity to total quantity for current procedure
|
|
S ^TMP("SCRPW",$J,SDIV,1,SDS,"PROC",SDP)=$G(^TMP("SCRPW",$J,SDIV,1,SDS,"PROC",SDP))+SDQ
|
|
;
|
|
;Loop through modifiers and add to ^TMP array
|
|
N SDMODN,SDMOD
|
|
S SDMODN=0
|
|
F S SDMODN=+$O(SDLIST(SDVP,1,SDMODN)) Q:'SDMODN D
|
|
.S SDMOD=$P(SDLIST(SDVP,1,SDMODN,0),"^")
|
|
.;add modifier quantity to array
|
|
.S:SDMOD ^TMP("SCRPW",$J,SDIV,1,SDS,"PROC",SDP,SDMOD)=$G(^TMP("SCRPW",$J,SDIV,1,SDS,"PROC",SDP,SDMOD))+SDQ
|
|
Q
|
|
;
|
|
CAT(SDS) ;Determine if encounter fits category
|
|
;Required input: SDS array to return list
|
|
;Output: SDS(ifn) array=list of category ifns to tally
|
|
I SD("CAT")="C" S SDCL=$P(SDOE0,U,4) Q:SDCL<1 0 S:SD("FMT")="S"!$D(SD("LIST",+SDCL)) SDS(SDCL)="" Q $D(SDS)
|
|
I SD("CAT")="P" D CATP Q $D(SDS)
|
|
I SD("CAT")="S" D CATS Q $D(SDS)
|
|
Q 0
|
|
;
|
|
CATP ;Get providers
|
|
K SDLIST D GETPRV^SDOE(SDOE,"SDLIST")
|
|
S SDPI=0 F S SDPI=$O(SDLIST(SDPI)) Q:'SDPI S SDP=$P(SDLIST(SDPI),U) S:SD("FMT")="S"!$D(SD("LIST",SDP)) SDS(SDP)=""
|
|
Q
|
|
;
|
|
CATS ;Get stop codes
|
|
S SDSC=+$P(SDOE0,U,3) S:SD("FMT")="S"!$D(SD("LIST",SDSC)) SDS(SDSC)=""
|
|
S SDCH=0 F S SDCH=$O(^SCE("APAR",SDOE,SDCH)) Q:'SDCH S SDCH0=$$GETOE^SDOE(SDCH) I $P(SDCH0,U,8)=4 S SDSC=+$P(SDCH0,U,3) S:SD("FMT")="S"!$D(SD("LIST",SDSC)) SDS(SDSC)=""
|
|
Q
|