105 lines
7.4 KiB
Mathematica
105 lines
7.4 KiB
Mathematica
SCRPW27 ;RENO/KEITH - ACRP Ad Hoc Report (cont.) ; 03 Aug 98 9:06 PM
|
|
;;5.3;Scheduling;**144**;AUG 13, 1993
|
|
PRT ;Print ACRP Ad Hoc Report
|
|
D:$E(IOST)="C" DISP0^SCRPW23 S SDOUT=0 G:$P(SDPAR("F",6),U)="F" PFT G PDF^SCRPW28
|
|
;
|
|
HIN ;Header initialization
|
|
D NOW^%DTC S SDHIN=1,Y=% X ^DD("DD") S SDPNOW=$P(Y,":",1,2),SDPAGE=1,SDLINE="",$P(SDLINE,"-",(IOM+1))="",SDPBDT=$P($G(SDPAR("L",1)),U,2),SDPEDT=$P($G(SDPAR("L",2)),U,2),SDTITLX=$P($G(SDPAR("O",2)),U)
|
|
Q
|
|
;
|
|
PFT ;Print as formatted text
|
|
S SDCOL=$S(SDF(2):0,IOM=80:3,1:29) F SDR="RPAR","RPRT","RDET" D @SDR Q:SDOUT
|
|
I $E(IOST)="C",'SDOUT D N DIR S DIR(0)="E" D ^DIR
|
|
.F Q:$Y>(IOSL-2) W !
|
|
.Q
|
|
G EXIT
|
|
;
|
|
PPAR ;Print parameters only
|
|
D RPAR K:$D(ZTQUEUED) SDPNOW,SDPAGE,SDLINE,SDPBDT,SDPEDT,SDTITLX Q
|
|
;
|
|
RPAR ;Print report parameters
|
|
D:$E(IOST)'="C" HDR^SCRPW29("Report Parameters Selected") Q:SDOUT D PLIST^SCRPW22((IOM-80\2),$S($E(IOST)="C":15,1:(IOSL-10))) Q
|
|
;
|
|
RPRT ;Print formatted report
|
|
W @IOF N DX,DY S (DX,DY)=0 X SDXY
|
|
S SDPAGE=1,SDS1="" D HDR^SCRPW29("Report Summary") Q:SDOUT I '$D(^TMP("SCRPW",$J,"RPT",1)) S SDX="No data found within selected parameters." W !!?(IOM-$L(SDX)\2),SDX S SDOUT=1 Q
|
|
D HD1^SCRPW29 S SDORDV=""
|
|
F S SDORDV=$O(^TMP("SCRPW",$J,"MASTER",SDORDV),$S(SDORD="ALP":1,1:-1)) Q:SDORDV=""!SDOUT D RPRT0
|
|
Q:SDOUT D RPRT1("TOT",1,1) Q
|
|
;
|
|
RPRT0 S SDS1="" F S SDS1=$O(^TMP("SCRPW",$J,"MASTER",SDORDV,SDS1)) Q:SDS1=""!SDOUT S SDS2="" F S SDS2=$O(^TMP("SCRPW",$J,"MASTER",SDORDV,SDS1,SDS2)) Q:SDS2=""!SDOUT D RPRT1("RPT",SDS1,SDS2)
|
|
Q
|
|
;
|
|
RPRT1(SDRPT,SDS1,SDS2) K SDX S SDX=$S(SDRPT="TOT":"REPORT TOTAL:",$G(SDPAR("P",1,6))="D":SDS2,1:SDS1)
|
|
S SDX(0)=+$G(^TMP("SCRPW",$J,SDRPT,1,SDS1,SDS2,"ENC")),SDX(1)=+$G(^TMP("SCRPW",$J,SDRPT,1,SDS1,SDS2,"VIS")),SDX(2)=+$G(^TMP("SCRPW",$J,SDRPT,1,SDS1,SDS2,"UNI"))
|
|
I SDCOL=0 S SDX(3)=+$G(^TMP("SCRPW",$J,SDRPT,2,SDS1,SDS2,"ENC")),SDX(4)=+$G(^TMP("SCRPW",$J,SDRPT,2,SDS1,SDS2,"VIS")),SDX(5)=+$G(^TMP("SCRPW",$J,SDRPT,2,SDS1,SDS2,"UNI"))
|
|
I SDCOL=0 F SDI=6,7,8 D CALC(SDI)
|
|
D:$Y>(IOSL-6) HDR^SCRPW29("Report Summary"),HD1^SCRPW29 Q:SDOUT
|
|
I SDRPT="TOT" W !?(SDCOL),"========================================== ======== ======== ======== " W:SDCOL=0 "======== ======== ======== ======== ======== ========"
|
|
W !?(SDCOL),$E(SDX,1,42) S SDI="" F S SDI=$O(SDX(SDI)) Q:SDI=""!SDOUT W ?(SDCOL+44+(10*SDI)),$S(SDX(SDI)="N/A":$J(SDX(SDI),8),1:$J(SDX(SDI),8,$S(SDI<6:0,SDX(SDI)'<100000:0,SDX(SDI)'<10000:1,1:2)))
|
|
Q
|
|
;
|
|
CALC(SDI) ;Calculate % change
|
|
S SDX(SDI)=$S(SDX(SDI-3)<1:"N/A",1:SDX(SDI-6)-SDX(SDI-3)*100/SDX(SDI-3))
|
|
;
|
|
RDET Q:SDOUT!(SDF(1)="S") S SDS1="" F S SDS1=$O(^TMP("SCRPW",$J,"RPT",1,SDS1)) Q:SDOUT!(SDS1="") S SDS2="" F S SDS2=$O(^TMP("SCRPW",$J,"RPT",1,SDS1,SDS2)) Q:SDOUT!(SDS2="") D RDET1
|
|
Q
|
|
;
|
|
RDET1 S SDENC=^TMP("SCRPW",$J,"RPT",1,SDS1,SDS2,"ENC"),SDVIS=^TMP("SCRPW",$J,"RPT",1,SDS1,SDS2,"VIS"),SDUNI=^TMP("SCRPW",$J,"RPT",1,SDS1,SDS2,"UNI")
|
|
S SDPTX(1)="Detail of "_$P(SDPAR("P",1,1),U,2)_": "_$S($G(SDPAR("P",1,6))="D":SDS2,1:SDS1),SDPTX(2)="Encounters: "_SDENC_" Visits: "_SDVIS_" Uniques: "_SDUNI D HDR^SCRPW29("Report Detail"),HD2^SCRPW29 Q:SDOUT
|
|
D:"EB"[SDF(3) DPTL Q:SDOUT D:"DB"[SDF(3) DDXP Q
|
|
;
|
|
DSV(SDPER) ;Encrypt detail sort values
|
|
N SDX S SDX=$G(^TMP("SCRPW",$J,"DSV",$P(SDPER,U,2),$P(SDPER,U))) Q:SDX SDX
|
|
S (SDX,^TMP("SCRPW",$J,"DSV",0))=$G(^TMP("SCRPW",$J,"DSV",0))+1
|
|
S ^TMP("SCRPW",$J,"DSV",$P(SDPER,U,2),$P(SDPER,U))=SDX Q SDX
|
|
;
|
|
DPTL ;Detail patient list
|
|
N SDDSV S SDDSV=$$DSV(SDS2_"^"_SDS1)
|
|
S SDCOL=$S($D(SDPAR("PF")):0,IOM=80:0,1:26) D DPHD^SCRPW29
|
|
S SDPNAM="" F S SDPNAM=$O(^TMP("SCRPW",$J,"DET",SDDSV,SDPNAM)) Q:SDOUT!(SDPNAM="") S DFN=0 F S DFN=$O(^TMP("SCRPW",$J,"DET",SDDSV,SDPNAM,DFN)) Q:SDOUT!'DFN D DPTL1
|
|
Q
|
|
;
|
|
DPTL1 S SDI=0 I SDF(4)="U" D:$Y>(IOSL-6) HDR^SCRPW29("Report Detail"),HD2^SCRPW29,DPHD^SCRPW29 Q:SDOUT W !?(SDCOL+19),SDPNAM,?(SDCOL+51),$P($G(^DPT(DFN,0)),U,9) D APFP^SCRPW29 S SDI=SDI+1 Q
|
|
S SDT=0 F S SDT=$O(^TMP("SCRPW",$J,"DET",SDDSV,SDPNAM,DFN,SDT)) Q:SDOUT!'SDT D DPTL2
|
|
Q
|
|
;
|
|
DPTL2 I SDF(4)="V" D:$Y>(IOSL-6) HDR^SCRPW29("Report Detail"),HD2^SCRPW29,DPHD^SCRPW29 Q:SDOUT W !?(SDCOL+13),SDPNAM,?(SDCOL+45),$P($G(^DPT(DFN,0)),U,9) S Y=SDT X ^DD("DD") W ?(SDCOL+57),Y D APFP^SCRPW29 S SDI=SDI+1 Q
|
|
S SDDT=0 F S SDDT=$O(^TMP("SCRPW",$J,"DET",SDDSV,SDPNAM,DFN,SDT,SDDT)) Q:SDOUT!'SDDT S SDOE=0 F S SDOE=$O(^TMP("SCRPW",$J,"DET",SDDSV,SDPNAM,DFN,SDT,SDDT,SDOE)) Q:SDOUT!'SDOE D DPTL3
|
|
Q
|
|
;
|
|
DPTL3 D:$Y>(IOSL-6) HDR^SCRPW29("Report Detail"),HD2^SCRPW29,DPHD^SCRPW29 Q:SDOUT
|
|
S SDCL=^TMP("SCRPW",$J,"DET",SDDSV,SDPNAM,DFN,SDT,SDDT,SDOE),SDCL=$P($G(^SC(SDCL,0)),U),Y=SDDT X ^DD("DD")
|
|
W !?(SDCOL),$E(SDPNAM,1,18),?(SDCOL+20),$P($G(^DPT(DFN,0)),U,9) W ?(SDCOL+32),$P(Y,":",1,2),?(SDCOL+52),$E(SDCL,1,28) D APFP^SCRPW29 S SDI=SDI+1 Q
|
|
;
|
|
DDXP ;Detail dx/procedure lists
|
|
I $Y>(IOSL-10) D HDR^SCRPW29("Report Detail"),HD2^SCRPW29,DDPH^SCRPW29("D") Q:SDOUT G DDXP0
|
|
W:SDF(3)="B" !! D DDPH^SCRPW29("D")
|
|
DDXP0 I '$D(^TMP("SCRPW",$J,"RPTTDX",1,SDS1,SDS2)) W !!,"No diagnoses found for this detail item." G DAPP
|
|
K SDTCT S SDQT="",SDCT=0
|
|
F S SDQT=$O(^TMP("SCRPW",$J,"RPTTDX",1,SDS1,SDS2,SDQT),-1) Q:SDOUT!(SDQT="")!(SDCT>(SDF(5)-1)) S SDS3="" F S SDS3=$O(^TMP("SCRPW",$J,"RPTTDX",1,SDS1,SDS2,SDQT,SDS3)) Q:SDOUT!(SDS3="")!(SDCT>(SDF(5)-1)) D DDXP1
|
|
Q:SDOUT D:$Y>(IOSL-6) HDR^SCRPW29("Report Detail"),HD2^SCRPW29,DDPH^SCRPW29("D") Q:SDOUT
|
|
W !?(SDCOL),"====================================",?(SDCOL+40),"==========",?(SDCOL+55),"==========",?(SDCOL+70),"==========",!?(SDCOL),"TOTAL:",?(SDCOL+40),$J(SDTCT(1),10),?(SDCOL+55),$J(SDTCT(2),10),?(SDCOL+70),$J(SDTCT(3),10)
|
|
;
|
|
DAPP I $Y>(IOSL-10) D HDR^SCRPW29("Report Detail"),HD2^SCRPW29,DDPH^SCRPW29("P") Q:SDOUT G DAPP0
|
|
W !! D DDPH^SCRPW29("P")
|
|
DAPP0 I '$D(^TMP("SCRPW",$J,"RPTTAP",1,SDS1,SDS2)) W !!,"No procedures found for this detail item." Q
|
|
K SDTCT S SDQT="",SDCT=0
|
|
F S SDQT=$O(^TMP("SCRPW",$J,"RPTTAP",1,SDS1,SDS2,SDQT),-1) Q:SDOUT!(SDQT="")!(SDCT>(SDF(5)-1)) S SDS3="" F S SDS3=$O(^TMP("SCRPW",$J,"RPTTAP",1,SDS1,SDS2,SDQT,SDS3)) Q:SDOUT!(SDS3="")!(SDCT>(SDF(5)-1)) D DAPP1
|
|
Q:SDOUT D:$Y>(IOSL-6) HDR^SCRPW29("Report Detail"),HD2^SCRPW29,DDPH^SCRPW29("A") Q:SDOUT W !?(SDCOL+13),"======================================",?(SDCOL+56),"==========",!?(SDCOL+13),"TOTAL:",?(SDCOL+56),$J(SDTCT(1),10)
|
|
Q
|
|
;
|
|
DDXP1 D:$Y>(IOSL-6) HDR^SCRPW29("Report Detail"),HD2^SCRPW29,DDPH^SCRPW29("D") Q:SDOUT F SDI=1,2,3 S SDICT(SDI)=+$P(^TMP("SCRPW",$J,"RPTDX",1,SDS1,SDS2,SDS3),U,SDI),SDTCT(SDI)=$G(SDTCT(SDI))+SDICT(SDI)
|
|
W !?(SDCOL),SDS3,?(SDCOL+40),$J(SDICT(1),10),?(SDCOL+55),$J(SDICT(2),10),?(SDCOL+70),$J(SDICT(3),10) S SDCT=SDCT+1 Q
|
|
;
|
|
DAPP1 D:$Y>(IOSL-6) HDR^SCRPW29("Report Detail"),HD2^SCRPW29,DDPH^SCRPW29("A") Q:SDOUT S SDICT(1)=^TMP("SCRPW",$J,"RPTAP",1,SDS1,SDS2,SDS3),SDTCT(1)=$G(SDTCT(1))+SDICT(1)
|
|
W !?(SDCOL+13),SDS3,?(SDCOL+56),$J(SDICT(1),10) S SDCT=SDCT+1 Q
|
|
;
|
|
EXIT D DISP0^SCRPW23,KVA^VADPT,KILL^%ZISS S X=IOM X ^%ZOSF("RM")
|
|
K %,%DT,%Y,C,DFN,DIC,DIR,DTOUT,DUOUT,I,II,S1,S2,SD,SDA,SDACT,SDATE,SDBOT,SDCL,SDCOL,SDCT,SDDT,SDDV,SDE,SDEDT,SDEF,SDENC,SDEXE,SDF,SDFE,SDFI,SDFL
|
|
K SDFOUND,SDH,SDI,SDICT,SDII,SDIRB,SDIRQ,SDISP,SDL,SDLEV,SDLINE,SDLP,SDLR,SDNUL,SDO,SDOE,SDOE0,SDOCH,SDOUT,SDP,SDPAGE,SDPAR,SDPBDT,SDPER,SDPNAM
|
|
K SDPNOW,SDPTX,SDQT,SDR,SDR1,SDR2,SDREV,SDRPT,SDS,SDS1,SDS2,SDS3,SDDSC1,SDSC2,SDSEL,SDT,SDTAG,SDTCT,SDTITL,SDTITLX,SDTOP,SDTX,SDTYP,SDU,SDUNI
|
|
K SDAPFM,SDD,SDPFL,SDIII,S0,SDLPX,SDHIN,SDV,SDVIS,SDX,SDX1,SDX2,SDY,SDYR,SDZ,T,X,X1,X2,Y,ZTSAVE,SDSTOP,SDXY,SDTEMP,SDRM,D0,DINUM,SDNEW,SDOECH
|
|
K SDOECH,SDORD,SDORDV,SDS4,SDTOT,^TMP("SCRPW",$J)
|
|
Q
|