112 lines
8.3 KiB
Mathematica
112 lines
8.3 KiB
Mathematica
SCRPW11 ;RENO/KEITH - Patient Activity by Appointment Frequency ; 15 Jul 98 02:38PM
|
|
;;5.3;Scheduling;**139,144**;AUG 13, 1993
|
|
D TITL^SCRPW50("Patient Activity by Appointment Frequency") N SDDIV Q:'$$DIVA^SCRPW17(.SDDIV)
|
|
DTR 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)) EXIT G:X="" EXIT
|
|
G:Y<1 FDT S SDBDAY=Y X ^DD("DD") S SDPBDA=Y
|
|
LDT W ! S %DT("A")=" Ending date: " D ^%DT G:X=U!($D(DTOUT)) EXIT G:X="" EXIT
|
|
I Y<SDBDAY W !!,$C(7),"Ending date must be after beginning date!" G LDT
|
|
G:Y<1 LDT S SDEDAY=Y X ^DD("DD") S SDPEDA=Y
|
|
D SUBT^SCRPW50("*** Report Format Selection ***")
|
|
W ! S DIR(0)="N^1:999:0",DIR("?")="Enter the minimum number of appointments for a patient to be included in this report",DIR("A")="Minimum appointment frequency" D ^DIR G:Y'>0 EXIT S SDMIN=Y
|
|
K DIR S DIR(0)="S^R:RANGE OF STOP CODES;S:SELECTED STOP CODES;C:CLINIC GROUP",DIR("A")="Limit clinics by",DIR("?")="Output will be limited to primary stop codes or clinic group as specified."
|
|
D ^DIR G:$D(DTOUT)!$D(DUOUT) EXIT S SDFMT=Y,SDOUT=0 D @(SDFMT) G:SDOUT EXIT
|
|
D SUBT^SCRPW50("*** Output Order Selection ***")
|
|
K DIR S DIR(0)="S^A:ALPHABETIC;V:VISIT FREQUENCY",DIR("A")="Specify output order" D ^DIR G:$D(DTOUT)!$D(DUOUT) EXIT S SDORD=Y
|
|
N ZTSAVE F V="SD(","SDDIV","SDDIV(","SDFMT","SDMIN","SDBDAY","SDEDAY","SDPBDA","SDPEDA","SDBCS","SDECS","SDORD","SDMC","SDMD" S ZTSAVE(V)=""
|
|
W !!,"This report requires 132 column output.",! D EN^XUTMDEVQ("START^SCRPW11","PT. ACTIVITY BY APPT. FREQUENCY",.ZTSAVE) G EXIT
|
|
;
|
|
START K ^TMP("SCRPW",$J) S (SDOUT,SDSTOP)=0,SDMD=$O(SDDIV(0)),SDMD=$O(SDDIV(SDMD)) S:$P(SDDIV,U,2)="ALL DIVISIONS" SDMD=1
|
|
I SDFMT="C" S SDCG=$O(SD(0)),SDCL=0 F S SDCL=$O(^SC("ASCRPW",SDCG,SDCL)) Q:'SDCL S SDCL0=$G(^SC(SDCL,0)) I $$DIV() D LOOP Q:SDOUT
|
|
G:SDOUT EXIT
|
|
I SDFMT'="C" S SDCL=0 F S SDCL=$O(^SC(SDCL)) Q:SDCL'>0 S SDCL0=$G(^SC(SDCL,0)) I $$DIV() D LOOP Q:SDOUT
|
|
G:SDOUT EXIT
|
|
S SDIV="" F S SDIV=$O(^TMP("SCRPW",$J,SDIV)) Q:SDIV=""!SDOUT S DFN=0 F S DFN=$O(^TMP("SCRPW",$J,SDIV,0,DFN)) Q:DFN'>0 S SDSTOP=SDSTOP+1 D:SDSTOP#1000=0 STOP Q:SDOUT D FAPP,ORDR
|
|
S SDII=1,SDT(SDII)="<*> PATIENT ACTIVITY BY APPOINTMENT FREQUENCY <*>" S:SDFMT="R" SDII=SDII+1,SDT(SDII)="IN CLINICS WITH PRIMARY STOP CODES "_SDBCS_" TO "_SDECS
|
|
I SDFMT="S" S SDI=0 F S SDI=$O(SD(SDI)) Q:'SDI S SDII=SDII+1,SDT(SDII)="IN CLINICS WITH PRIMARY STOP CODE: "_SDI
|
|
I SDFMT="C" S SDII=SDII+1,SDT(SDII)="IN CLINIC GROUP: "_SD(SDCG)
|
|
S SDII=SDII+1,SDT(SDII)="FOR PATIENTS WITH AT LEAST "_SDMIN_" APPOINTMENTS TO THESE CLINICS",SDII=SDII+1
|
|
D NOW^%DTC S Y=% X ^DD("DD") S SDPNOW=$P(Y,":",1,2),SDPAGE=1,SDLINE="",$P(SDLINE,"-",133)=""
|
|
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 S (SDI,SDIV)="" F S SDIV=$O(^TMP("SCRPW",$J,SDIV)) Q:SDI!(SDIV="") S:$O(^TMP("SCRPW",$J,SDIV,2,(SDMIN-1))) SDI=1
|
|
I 'SDI S SDIV=0 D DHDR^SCRPW40(SDII,.SDT),HDR G:SDOUT EXIT S SDX="No activity found that meets report criteria!" 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)),SDMD=$O(^TMP("SCRPW",$J,SDI))
|
|
G:SDOUT EXIT I SDMD S SDIV=0 D DPRT(.SDIV)
|
|
I $E(IOST)="C",'SDOUT N DIR S DIR(0)="E" D ^DIR
|
|
G EXIT
|
|
;
|
|
DPRT(SDIV) ;Print report for a division
|
|
D DHDR^SCRPW40(SDII,.SDT) I '$O(^TMP("SCRPW",$J,SDIV,2,(SDMIN-1))) S SDX="No activity found for this division within report parameters!" D HDR Q:SDOUT W !!?(IOM-$L(SDX)\2),SDX Q
|
|
D HDR Q:SDOUT
|
|
S SDFREQ=999999999 F S SDFREQ=$O(^TMP("SCRPW",$J,SDIV,2,SDFREQ),-1) Q:SDFREQ'>0!(SDFREQ<SDMIN)!SDOUT S DFN=0 F S DFN=$O(^TMP("SCRPW",$J,SDIV,2,SDFREQ,DFN)) Q:DFN'>0!SDOUT D:SDORD="V" PRT D:SDORD="A" ALPH
|
|
I SDORD="A" S SDNAM="" F S SDNAM=$O(^TMP("SCRPW",$J,SDIV,3,SDNAM)) Q:SDNAM=""!SDOUT S DFN=0 F S DFN=$O(^TMP("SCRPW",$J,SDIV,3,SDNAM,DFN)) Q:'DFN!SDOUT S SDFREQ=^TMP("SCRPW",$J,SDIV,3,SDNAM,DFN) D PRT
|
|
Q
|
|
;
|
|
EXIT D END^SCRPW50 K SD,SDFMT,SDBCS,SDBDAY,SDCL,SDCL0,SDCLCS,SDCLPT,SDCS,SDDAY,DFN,SDECS,SDEDAY,SDFREQ,SDMIN,SDPTAP0,SDPTCLT,SDPTCSF,SDI,SDOUT,DIC,DTOUT,DUOUT,%,%H,%I,%DT,SDDIV,SDII,SDMC,SDMD,X,SDIVN,SDSTOP,SDX
|
|
D KVA^VADPT K SDCG,SDORD,SDNAM,SDCLNA,SDPTCS,SDT,SDBDAY,SDEDAY,SDRBDA,SDREDA,SDPBDA,SDPEDA,SDPNOW,SDLINE,SDPAGE,DGPGM,DGVAR,DIR,POP,Y,V,ZTSAVE,^TMP("SCRPW",$J) Q
|
|
;
|
|
STOP ;Check for stop task request
|
|
S:$G(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
|
|
;
|
|
R K DIR S DIR(0)="N^101:999:0",DIR("?")="Specify a range of Clinic Stop codes defined for clinics to be returned in this report",DIR("A")="Start with CLINIC STOP"
|
|
W ! D ^DIR S:$D(DTOUT)!$D(DUOUT)!($G(Y)<1) SDOUT=1 Q:SDOUT S SDBCS=Y,DIR(0)="N^"_Y_":999:0",DIR("A")="End with CLINIC STOP" D ^DIR S:$D(DTOUT)!$D(DUOUT)!($G(Y)<1) SDOUT=1 Q:SDOUT S SDECS=Y Q
|
|
;
|
|
S K SD,DIC S DIC="^DIC(40.7,",DIC(0)="AEMQZ" F D S1 Q:$G(Y)<1
|
|
S:$D(DTOUT)!$D(DUOUT)!'$D(SD) SDOUT=1 Q
|
|
;
|
|
S1 D ^DIC I Y>0 S SD($P(Y(0),U,2))=""
|
|
Q
|
|
;
|
|
C K SD,DIC S DIC="^SD(409.67,",DIC(0)="AEMQ" W ! D ^DIC I $D(DTOUT)!$D(DUOUT)!($G(Y)<1) S SDOUT=1 Q
|
|
S SD(+Y)=$P(Y,U,2) Q
|
|
;
|
|
DIV() ;Check division
|
|
Q:'SDDIV 1 Q $D(SDDIV(+$P(SDCL0,U,15)))
|
|
;
|
|
LOOP S SDCLCS=$P(SDCL0,U,7),SDCLCS=$P($G(^DIC(40.7,+SDCLCS,0)),U,2),SDIV=$P(SDCL0,U,15) S:'SDIV SDIV=$$PRIM^VASITE()
|
|
I SDFMT="R" Q:SDCLCS<SDBCS!(SDCLCS>SDECS)
|
|
I SDFMT="S" Q:'$D(SD(+SDCLCS))
|
|
L1 S SDDAY=SDBDAY F S SDDAY=$O(^SC(SDCL,"S",SDDAY)) Q:(SDDAY'>0!(SDDAY>SDEDAY))!SDOUT S SDCLPT=0 F S SDCLPT=$O(^SC(SDCL,"S",SDDAY,1,SDCLPT)) Q:SDCLPT'>0!SDOUT S DFN=+^SC(SDCL,"S",SDDAY,1,SDCLPT,0) D EVAL
|
|
Q
|
|
;
|
|
EVAL S SDSTOP=SDSTOP+1 I SDSTOP#1000=0 D STOP Q:SDOUT
|
|
S SDPTAP0=^DPT(DFN,"S",SDDAY,0) Q:$P(SDPTAP0,U,2)["C"!($P(SDPTAP0,U,2)["N") D EV1(SDIV) D:SDMD EV1(0)
|
|
Q
|
|
;
|
|
EV1(SDIV) S ^TMP("SCRPW",$J,SDIV,0,DFN)=$G(^TMP("SCRPW",$J,SDIV,0,DFN))+1,^TMP("SCRPW",$J,SDIV,0,DFN,SDCLCS,$P(SDCL0,U))=$G(^TMP("SCRPW",$J,SDIV,0,DFN,SDCLCS,$P(SDCL0,U)))+1
|
|
S ^TMP("SCRPW",$J,SDIV,0,DFN,SDCLCS)=$G(^TMP("SCRPW",$J,SDIV,0,DFN,SDCLCS))+1 Q
|
|
;
|
|
FAPP S SDDAY=DT F S SDDAY=$O(^DPT(DFN,"S",SDDAY)) Q:SDDAY'>0 S SDPTAP0=^DPT(DFN,"S",SDDAY,0),SDCL=+SDPTAP0,SDCL0=^SC(SDCL,0),SDCLCS=$P(SDCL0,U,7),SDCLCS=$P(^DIC(40.7,SDCLCS,0),U,2) D FAP1
|
|
Q
|
|
;
|
|
FAP1 I SDFMT="R",$P(SDPTAP0,U,2)'["C",SDCLCS'<SDBCS,SDCLCS'>SDECS S ^TMP("SCRPW",$J,SDIV,1,DFN,SDDAY,$P(SDCL0,U))=SDCLCS
|
|
I SDFMT="S",$P(SDPTAP0,U,2)'["C",$D(SD(+SDCLCS)) S ^TMP("SCRPW",$J,SDIV,1,DFN,SDDAY,$P(SDCL0,U))=SDCLCS
|
|
Q
|
|
;
|
|
ORDR S SDFREQ=^TMP("SCRPW",$J,SDIV,0,DFN),^TMP("SCRPW",$J,SDIV,2,SDFREQ,DFN)="",SDPTCS=0
|
|
F S SDPTCS=$O(^TMP("SCRPW",$J,SDIV,0,DFN,SDPTCS)) Q:SDPTCS'>0 S SDPTCSF=^TMP("SCRPW",$J,SDIV,0,DFN,SDPTCS),^TMP("SCRPW",$J,SDIV,2,SDFREQ,DFN,SDPTCSF,SDPTCS)=""
|
|
Q
|
|
;
|
|
HDR ;Print report header
|
|
D STOP Q:SDOUT
|
|
I $E(IOST)="C",SDPAGE>1 N DIR S DIR(0)="E" D ^DIR S SDOUT=Y'=1 Q:SDOUT
|
|
W:SDPAGE>1!($E(IOST)="C") $$XY^SCRPW50(IOF,1,0) W:$X $$XY^SCRPW50("",0,0) W SDLINE S SDI=0 F S SDI=$O(SDT(SDI)) Q:'SDI W !?(132-$L(SDT(SDI))\2),SDT(SDI)
|
|
W !,SDLINE,!,"For date range: ",SDPBDA," to ",SDPEDA,!,"Date printed: ",SDPNOW,?(126-$L(SDPAGE)),"Page: ",SDPAGE,!,SDLINE S SDPAGE=SDPAGE+1 Q
|
|
;
|
|
PRT D:$Y>(IOSL-7) HDR Q:SDOUT D ^VADPT W !!,"Number of appts.: ",SDFREQ,?24,"Patient: ",$E(VADM(1),1,30),?65,"SSN: ",$P(VADM(2),U,2)
|
|
S SDPTCSF=99999999 F S SDPTCSF=$O(^TMP("SCRPW",$J,SDIV,2,SDFREQ,DFN,SDPTCSF),-1) Q:SDPTCSF'>0!SDOUT S SDCLCS=0 F S SDCLCS=$O(^TMP("SCRPW",$J,SDIV,2,SDFREQ,DFN,SDPTCSF,SDCLCS)) Q:SDCLCS'>0!SDOUT D PRT1
|
|
I $D(^TMP("SCRPW",$J,SDIV,1,DFN)) D:$Y>(IOSL-5) HDR Q:SDOUT W !?44,"FUTURE APPOINTMENTS:" S SDDAY=0 F S SDDAY=$O(^TMP("SCRPW",$J,SDIV,1,DFN,SDDAY)) Q:SDDAY'>0!SDOUT D PRT2
|
|
Q
|
|
;
|
|
PRT1 D:$Y>(IOSL-6) HDR Q:SDOUT S SDCS=0,SDCS=$O(^DIC(40.7,"C",SDCLCS,SDCS)),SDCS=$P(^DIC(40.7,SDCS,0),U) W !?29,SDPTCSF," appointments to ",SDCS," (",SDCLCS,")"
|
|
S SDCLNA="" F S SDCLNA=$O(^TMP("SCRPW",$J,SDIV,0,DFN,SDCLCS,SDCLNA)) Q:SDCLNA']"" D:$Y>(IOSL-5) HDR Q:SDOUT S SDPTCLT=^TMP("SCRPW",$J,SDIV,0,DFN,SDCLCS,SDCLNA) W !?34,SDPTCLT," ",SDCLNA," appointment",$S(SDPTCLT=1:"",1:"s")
|
|
Q
|
|
;
|
|
PRT2 S SDCLNA="" F S SDCLNA=$O(^TMP("SCRPW",$J,SDIV,1,DFN,SDDAY,SDCLNA)) Q:SDCLNA']"" D:$Y>(IOSL-4) HDR Q:SDOUT S SDCLCS=^TMP("SCRPW",$J,SDIV,1,DFN,SDDAY,SDCLNA),Y=SDDAY X ^DD("DD") W !?44,Y," ",SDCLNA," (",SDCLCS,")"
|
|
Q
|
|
;
|
|
ALPH D ^VADPT S SDNAM=VADM(1),^TMP("SCRPW",$J,SDIV,3,SDNAM,DFN)=SDFREQ Q
|