165 lines
9.0 KiB
Mathematica
165 lines
9.0 KiB
Mathematica
|
SCRPW40 ;RENO/KEITH - Diagnosis/Procedure Frequency Report ;06/22/99
|
||
|
|
;;5.3;Scheduling;**144,180**;AUG 13, 1993
|
||
|
|
;06/22/99 ACS - Added CPT modifiers to the report
|
||
|
|
;06/22/99 ACS - Added CPT modifier API calls
|
||
|
|
;
|
||
|
|
N SDDIV,SD,%DT,X,Y,DIR,SDX,LINEFLAG
|
||
|
|
D TITL^SCRPW50("Outpatient Diagnosis/Procedure Frequncy Report")
|
||
|
|
I '$$DIVA^SCRPW17(.SDDIV) S SDOUT=1 G EXIT
|
||
|
|
D SUBT^SCRPW50("**** Date Range Selection ****")
|
||
|
|
W ! S %DT="AEPX",%DT(0)=2961001,%DT("A")="Beginning date: " D ^%DT I Y<1 S SDOUT=1 G EXIT
|
||
|
|
S SD("BDT")=Y
|
||
|
|
EDT S %DT("A")=" Ending date: " W ! D ^%DT I Y<1 S SDOUT=1 G EXIT
|
||
|
|
I Y<SD("BDT") W !!,$C(7),"End date cannot be before begin date!",! G EDT
|
||
|
|
S SD("EDT")=Y_.999999
|
||
|
|
D SUBT^SCRPW50("**** Report Format Selection ****")
|
||
|
|
K DIR S DIR(0)="S^D:DIAGNOSIS FREQUENCY;P:PROCEDURE FREQUENCY;B:BOTH DIAGNOSIS AND PROCEDURE",DIR("A")="Specify the type of report to print",DIR("?")="This determines the type of lists returned by the report."
|
||
|
|
D ^DIR I $D(DTOUT)!$D(DUOUT) S SDOUT=1 G EXIT
|
||
|
|
S SD("TYPE")=Y
|
||
|
|
K DIR S DIR(0)="N^1:99999:0",DIR("A")="Limit list to most frequent",DIR("B")=50,DIR("?")="Enter the quantity of the most frequent items to list."
|
||
|
|
W ! D ^DIR I $D(DTOUT)!$D(DUOUT) S SDOUT=1 G EXIT
|
||
|
|
S SD("FREQ")=Y
|
||
|
|
W ! N ZTSAVE S ZTSAVE("SDDIV")="",ZTSAVE("SDDIV(")="",ZTSAVE("SD(")="" D EN^XUTMDEVQ("START^SCRPW40","Outpatient Diagnosis/Procedure Frequency Report",.ZTSAVE) S SDOUT=1 G EXIT
|
||
|
|
;
|
||
|
|
START ;Print report
|
||
|
|
S (SDOUT,SDSTOP)=0 K ^TMP("SCRPW",$J) S SDI=$O(SDDIV("")),SDI=$O(SDDIV(SDI)) S:$P(SDDIV,U,2)="ALL DIVISIONS" SDI=1 S SDDIV("MULT")=SDI
|
||
|
|
S SDT=SD("BDT") F S SDT=$O(^SCE("B",SDT)) Q:'SDT!(SDT>SD("EDT"))!SDOUT S SDOE=0 F S SDOE=$O(^SCE("B",SDT,SDOE)) Q:'SDOE!SDOUT S SDOE0=$$GETOE^SDOE(SDOE) I '$P(SDOE0,U,6),$P(SDOE0,U,2),$P(SDOE0,U,4),$$DIV() D EVAL
|
||
|
|
G:SDOUT EXIT S SDIV="" F S SDIV=$O(^TMP("SCRPW",$J,SDIV)) Q:SDIV="" D ORD
|
||
|
|
D STOP G:SDOUT EXIT D NOW^%DTC S Y=% X ^DD("DD") S SDPNOW=$P(Y,":",1,2),SDPAGE=1,SDLINE="",$P(SDLINE,"-",(IOM+1))="",SDFF=0
|
||
|
|
S Y=SD("BDT") X ^DD("DD") S SDPBDT=Y,Y=$P(SD("EDT"),".") X ^DD("DD") S SDPEDT=Y,SDT(1)="<*> OUTPATIENT "_$S(SD("TYPE")="D":"DIAGNOSIS",SD("TYPE")="P":"PROCEDURE",1:"DIAGNOSIS/PROCEDURE")_" FREQUENCY REPORT <*>"
|
||
|
|
S SDT(2)="For the "_SD("FREQ")_" most frequent "_$S(SD("TYPE")="D":"diagnoses",SD("TYPE")="P":"procedures",1:"diagnoses and procedures")
|
||
|
|
S SDIV="" F S SDIV=$O(SDDIV(SDIV)) Q:'SDIV S SDIV(SDDIV(SDIV))=SDIV
|
||
|
|
I 'SDDIV,$P(SDDIV,U,2)'="ALL DIVISIONS" S SDIV($P(SDDIV,U,2))=$$PRIM^VASITE()
|
||
|
|
I $P(SDDIV,U,2)="ALL DIVISIONS" S SDI=0 F S SDI=$O(^TMP("SCRPW",$J,SDI)) Q:'SDI S SDX=$P($G(^DG(40.8,SDI,0)),U) S:$L(SDX) SDIV(SDX)=SDI
|
||
|
|
D:$E(IOST)="C" DISP0^SCRPW23 I '$O(^TMP("SCRPW",$J,0)) S SDIV=0 D DHDR(2,.SDT) D HDR Q:SDOUT S SDX="No activity found within selected report parameters!" W !!?(IOM-$L(SDX)\2),SDX G EXIT
|
||
|
|
S SDIVN="" F S SDIVN=$O(SDIV(SDIVN)) Q:SDIVN=""!SDOUT S SDIV=SDIV(SDIVN) D DPRT(.SDIV)
|
||
|
|
S SDI=0,SDI=$O(^TMP("SCRPW",$J,SDI)),SDDIV("MULT")=$O(^TMP("SCRPW",$J,SDI))
|
||
|
|
G:SDOUT EXIT I SDDIV("MULT") S SDIV=0 D DPRT(.SDIV)
|
||
|
|
;
|
||
|
|
EXIT I $E(IOST)="C",'$G(SDOUT) N DIR S DIR(0)="E" D ^DIR
|
||
|
|
K %,%DT,C,DIR,DIVN,DTOUT,DUOUT,SD,SDCT,SDDIV,SDDX,SDDX0,SDDXC,SDDXN,SDFF,SDI,SDII,SDIV,SDIVN,SDLINE,SDLIST,SDOE,SDOE0
|
||
|
|
K SDX,SDORD,SDOUT,SDPAGE,SDPBDT,SDPEDT,SDPNOW,SDPR,SDPR0,SDPRC,SDPRN,SDPROC,SDPS,SDQT,SDSTOP,SDT,SDTOT,X,Y D END^SCRPW50 Q
|
||
|
|
;
|
||
|
|
DIV() ;Check division
|
||
|
|
Q:'SDDIV 1 Q $D(SDDIV(+$P(SDOE0,U,11)))
|
||
|
|
;
|
||
|
|
STOP ;Check for stop task request
|
||
|
|
S:$D(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
|
||
|
|
;
|
||
|
|
EVAL ;Evaluate encounter
|
||
|
|
S SDSTOP=SDSTOP+1 D:SDSTOP#3000=0 STOP Q:SDOUT
|
||
|
|
S SDIV=+$P(SDOE0,U,11) D:"DB"[SD("TYPE") DX D:"PB"[SD("TYPE") PROC Q
|
||
|
|
;
|
||
|
|
DX ;Get diagnoses
|
||
|
|
N SDLIST,SDI D GETDX^SDOE(SDOE,"SDLIST")
|
||
|
|
S SDI=0 F S SDI=$O(SDLIST(SDI)) Q:'SDI D DX1(SDIV) D:SDDIV("MULT") DX1(0)
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
DX1(SDIV) S SDDX=+SDLIST(SDI),SDPS=$S($P(SDLIST(SDI),U,12)="P":"PRI",1:"SEC")
|
||
|
|
F SDPS=SDPS,"QTY" S ^TMP("SCRPW",$J,SDIV,"DX",1,SDDX,SDPS)=$G(^TMP("SCRPW",$J,SDIV,"DX",1,SDDX,SDPS))+1
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
PROC ;Get procedures
|
||
|
|
N SDLIST,SDI D GETCPT^SDOE(SDOE,"SDLIST")
|
||
|
|
S SDI=0 F S SDI=$O(SDLIST(SDI)) Q:'SDI D PROC1(SDIV) D:SDDIV("MULT") PROC1(0)
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
PROC1(SDIV) S SDPROC=+SDLIST(SDI),SDQT=$P(SDLIST(SDI),U,16) S:'SDQT SDQT=1
|
||
|
|
S ^TMP("SCRPW",$J,SDIV,"PROC",1,SDPROC,"ENC")=$G(^TMP("SCRPW",$J,SDIV,"PROC",1,SDPROC,"ENC"))+1
|
||
|
|
S ^TMP("SCRPW",$J,SDIV,"PROC",1,SDPROC,"QTY")=$G(^TMP("SCRPW",$J,SDIV,"PROC",1,SDPROC,"QTY"))+SDQT
|
||
|
|
;
|
||
|
|
;set encounter and modifier quantity
|
||
|
|
N SDMOD,SDMODN
|
||
|
|
S SDMODN=0
|
||
|
|
F S SDMODN=$O(SDLIST(SDI,1,SDMODN)) Q:SDMODN="" D
|
||
|
|
. S SDMOD=$G(SDLIST(SDI,1,SDMODN,0))
|
||
|
|
. Q:SDMOD=""
|
||
|
|
. S ^TMP("SCRPW",$J,SDIV,"PROC",1,SDPROC,SDMOD,"ENC")=+1
|
||
|
|
. S ^TMP("SCRPW",$J,SDIV,"PROC",1,SDPROC,SDMOD,"QTY")=+SDQT
|
||
|
|
. Q
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
ORD ;Determine list order
|
||
|
|
S SDI="" F S SDI=$O(^TMP("SCRPW",$J,SDIV,SDI)) Q:SDI="" S SDII=0 F S SDII=$O(^TMP("SCRPW",$J,SDIV,SDI,1,SDII)) Q:'SDII S ^TMP("SCRPW",$J,SDIV,SDI,2,$$ORDV(),SDII)=""
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
ORDV() Q ^TMP("SCRPW",$J,SDIV,SDI,1,SDII,"QTY")
|
||
|
|
;
|
||
|
|
DPRT(SDIV) ;Print report for a division
|
||
|
|
;Required input: SDIV=division ifn (or '0' for summary)
|
||
|
|
S C=(IOM-80\2) D DHDR(3,.SDT) I '$D(^TMP("SCRPW",$J,SDIV)) S SDPAGE=1 D HDR Q:SDOUT S SDX="No activity found for this date range!" W !!?(IOM-$L(SDX)\2),SDX Q
|
||
|
|
I $D(^TMP("SCRPW",$J,SDIV,"DX")) D DXPRT Q:SDOUT
|
||
|
|
I $D(^TMP("SCRPW",$J,SDIV,"PROC")) D PRPRT
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
DXPRT ;Print diagnosis list
|
||
|
|
N SDTOT S SDPAGE=1 D HDR Q:SDOUT D DXHD S (SDCT,SDORD)="" F S SDORD=$O(^TMP("SCRPW",$J,SDIV,"DX",2,SDORD),-1) Q:SDORD=""!SDOUT!(SDCT>(SD("FREQ")-1)) D DXP1
|
||
|
|
Q:SDOUT D:$Y>(IOSL-4) HDR,DXHD Q:SDOUT
|
||
|
|
W !?(C),$E(SDLINE,1,7),?(C+9),$E(SDLINE,1,35),?(C+46),$E(SDLINE,1,10),?(C+58),$E(SDLINE,1,10),?(C+70),$E(SDLINE,1,10)
|
||
|
|
W !?(C),"TOTAL:",?(C+46),$J(SDTOT("PRI"),9,0),?(C+58),$J(SDTOT("SEC"),9,0),?(C+70),$J(SDTOT("QTY"),9,0)
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
DXP1 S SDI=0 F S SDI=$O(^TMP("SCRPW",$J,SDIV,"DX",2,SDORD,SDI)) Q:'SDI!SDOUT!(SDCT>(SD("FREQ")-1)) S SDDX0=$G(^ICD9(SDI,0)) I $L(SDDX0) S SDDXC=$P(SDDX0,U),SDDXN=$P(SDDX0,U,3) D DXP2
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
DXP2 F SDII="PRI","SEC","QTY" S SDDX(SDII)=+$G(^TMP("SCRPW",$J,SDIV,"DX",1,SDI,SDII))
|
||
|
|
D:$Y>(IOSL-4) HDR,DXHD Q:SDOUT S SDCT=SDCT+1 W !?(C),SDDXC,?(C+9),$E(SDDXN,1,35),?(C+46),$J(SDDX("PRI"),9,0),?(C+58),$J(SDDX("SEC"),9,0),?(C+70),$J(SDDX("QTY"),9,0)
|
||
|
|
F SDII="PRI","SEC","QTY" S SDTOT(SDII)=$G(SDTOT(SDII))+SDDX(SDII)
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
PRPRT N SDTOT S C=(IOM-62\2),SDPAGE=1 D HDR Q:SDOUT D PRHD S (SDCT,SDORD)="" F S SDORD=$O(^TMP("SCRPW",$J,SDIV,"PROC",2,SDORD),-1) Q:SDORD=""!SDOUT!(SDCT>(SD("FREQ")-1)) D PRP1
|
||
|
|
Q:SDOUT D:$Y>(IOSL-4) HDR,PRHD Q:SDOUT
|
||
|
|
W !?(C),$E(SDLINE,1,6),?(C+8),$E(SDLINE,1,28),?(C+38),$E(SDLINE,1,10),?(C+50),$E(SDLINE,1,10),!?(C),"PROCEDURE TOTAL:",?(C+38),$J(SDTOT("ENC"),9,0),?(C+50),$J(SDTOT("QTY"),9,0)
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
PRP1 ;S SDI=0 F S SDI=$O(^TMP("SCRPW",$J,SDIV,"PROC",2,SDORD,SDI)) Q:'SDI!SDOUT!(SDCT>(SD("FREQ")-1)) S SDPR0=$G(^ICPT(SDI,0)) I $L(SDPR0) S SDPRC=$P(SDPR0,U),SDPRN=$P(SDPR0,U,2) D PRP2
|
||
|
|
N CPTINFO
|
||
|
|
S SDI=0 F S SDI=$O(^TMP("SCRPW",$J,SDIV,"PROC",2,SDORD,SDI)) Q:'SDI!SDOUT!(SDCT>(SD("FREQ")-1)) D
|
||
|
|
. S CPTINFO=$$CPT^ICPTCOD(SDI,,1)
|
||
|
|
. Q:CPTINFO'>0
|
||
|
|
. S SDPRC=$P(CPTINFO,U,2)
|
||
|
|
. S SDPRN=$P(CPTINFO,U,3)
|
||
|
|
. D PRP2
|
||
|
|
. Q
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
PRP2 F SDII="ENC","QTY" S SDPR(SDII)=+$G(^TMP("SCRPW",$J,SDIV,"PROC",1,SDI,SDII))
|
||
|
|
D:$Y>(IOSL-4) HDR,PRHD Q:SDOUT S SDCT=SDCT+1
|
||
|
|
; skip a line in the report if printing next cpt code on same page
|
||
|
|
I LINEFLAG W !
|
||
|
|
W !?(C),SDPRC,?(C+8),SDPRN,?(C+38),$J(SDPR("ENC"),9,0),?(C+50),$J(SDPR("QTY"),9,0)
|
||
|
|
S LINEFLAG=1
|
||
|
|
F SDII="ENC","QTY" S SDTOT(SDII)=$G(SDTOT(SDII))+SDPR(SDII)
|
||
|
|
;
|
||
|
|
;rank and print the modifiers
|
||
|
|
D START^SCRPW401($NA(^TMP("SCRPW",$J,SDIV,"PROC",1,SDI)))
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
PRHD ;Print procedure subheader
|
||
|
|
S LINEFLAG=0 Q:SDOUT W !!?(C),"CODE",!?(C),"NUMBER",?(C+8),"PROCEDURE/MODIFIER",?(C+38),"ENCOUNTERS",?(C+52),"QUANTITY",!?(C),$E(SDLINE,1,6),?(C+8),$E(SDLINE,1,28),?(C+38),$E(SDLINE,1,10),?(C+50),$E(SDLINE,1,10)
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
DXHD ;Print diagnosis subheader
|
||
|
|
Q:SDOUT W !!?(C),"CODE",?(C+49),"PRIMARY",?(C+59),"SECONDARY",?(C+75),"TOTAL",!?(C),"NUMBER",?(C+9),"DIAGNOSIS",?(C+47),"DIAGNOSIS",?(C+59),"DIAGNOSIS",?(C+71),"FREQUENCY"
|
||
|
|
W !?(C),$E(SDLINE,1,7),?(C+9),$E(SDLINE,1,35),?(C+46),$E(SDLINE,1,10),?(C+58),$E(SDLINE,1,10),?(C+70),$E(SDLINE,1,10) Q
|
||
|
|
;
|
||
|
|
HDR ;Print report header
|
||
|
|
I $E(IOST)="C",SDFF N DIR S DIR(0)="E" W ! D ^DIR S SDOUT=Y'=1 Q:SDOUT
|
||
|
|
D STOP Q:SDOUT
|
||
|
|
I SDFF!($E(IOST)="C") W $$XY^SCRPW50(IOF,1,0)
|
||
|
|
I $X W $$XY^SCRPW50("",0,0)
|
||
|
|
N SDI W SDLINE S SDI=0 F S SDI=$O(SDT(SDI)) Q:'SDI W !?(IOM-$L(SDT(SDI))\2),SDT(SDI)
|
||
|
|
W !,SDLINE,!,"For date range: ",SDPBDT," to ",SDPEDT,!,"Date printed: ",SDPNOW,?(IOM-6-$L(SDPAGE)),"Page: ",SDPAGE,!,SDLINE S SDPAGE=SDPAGE+1,SDFF=1 Q
|
||
|
|
;
|
||
|
|
DHDR(SDI,SDT) ;Set up division subheaders
|
||
|
|
;Required input: SDI=array number to start with
|
||
|
|
;Required input: SDT=array to store subheaders in (pass by reference)
|
||
|
|
S SDT(SDI)=$S('SDIV:"Summary for "_$P(SDDIV,U,2),SDDIV!($P(SDDIV,U,2)="ALL DIVISIONS"):"For division: "_SDIVN,1:"For facility: "_SDIVN)
|
||
|
|
I 'SDIV,$P(SDDIV,U,2)="SELECTED DIVISIONS" N SDIVN S SDIVN="" D Q
|
||
|
|
.F S SDIVN=$O(SDIV(SDIVN)) Q:SDIVN="" S SDI=SDI+1,SDT(SDI)="Division: "_SDIVN
|
||
|
|
.Q
|
||
|
|
I 'SDIV,$P(SDDIV,U,2)="ALL DIVISIONS" D
|
||
|
|
.N SDIV S SDIV=0 F S SDIV=$O(^TMP("SCRPW",$J,SDIV)) Q:'SDIV S SDI=SDI+1,SDT(SDI)="Division: "_$P($G(^DG(40.8,SDIV,0)),U)
|
||
|
|
.Q
|
||
|
|
Q
|