113 lines
5.1 KiB
Mathematica
113 lines
5.1 KiB
Mathematica
SDWLROS ;;IOFO BAY PINES/TEH - WAIT LIST OVERDUE REPORT-SUMMARY;06/12/2002 ; 20 Aug 2002 2:10 PM
|
|
;;5.3;scheduling;**263,414**;AUG 13 1993
|
|
;
|
|
;
|
|
;******************************************************************
|
|
; CHANGE LOG
|
|
;
|
|
; DATE PATCH DESCRIPTION
|
|
; ---- ----- -----------
|
|
;
|
|
;
|
|
;
|
|
;
|
|
EN ;
|
|
D INIT
|
|
I $$S^%ZTLOAD G END
|
|
D HD
|
|
D SORT
|
|
I $$S^%ZTLOAD G END
|
|
D PRT
|
|
I $$S^%ZTLOAD G END
|
|
D PRT1
|
|
K ^TMP("SDWLROS",$J)
|
|
Q
|
|
INIT ;Initialize variables
|
|
;
|
|
I $D(CT1) S SDWLCT1=CT1
|
|
I $D(CT2) S SDWLCT2=CT2
|
|
I $D(FORM) S SDWLFORM=FORM
|
|
I $D(INS) S SDWLINS=INS
|
|
S SDWLPG=0
|
|
I $D(ZTSAVE) D
|
|
.F SDWLI="CT1","CT2","FORM","INS" S SDWL="SDWL"_SDWLI,@SDWL=$G(ZTSAVE(SDWLI))
|
|
I SDWLINS="ALL" S SDWLIN("ALL")=""
|
|
S SDWLTXP=$P(SDWLCT1,U,3),SDWLF=$P(SDWLCT1,U,2)
|
|
I SDWLINS'="ALL" F SDWLI=1:1 S SDWLIN=$P($P(SDWLINS,";",SDWLI),U,1) Q:SDWLIN="" S SDWLIN(SDWLIN)=""
|
|
I SDWLCT2'="ALL" F SDWLI=1:1 S SDWLCL=$P($P(SDWLCT2,";",SDWLI),U,1) Q:SDWLCL="" S SDWLCT2(SDWLCL)=""
|
|
D NOW^%DTC S Y=% D DD^%DT S SDWLDTP=Y
|
|
Q
|
|
SORT ;Sort Records
|
|
K ^TMP("SDWLROS",$J)
|
|
S SDWLDA=0 F S SDWLDA=$O(^SDWL(409.3,SDWLDA)) Q:SDWLDA<1 D
|
|
.S SDWLX=$G(^SDWL(409.3,SDWLDA,0)),SDWLERR=0,SDWLDFN=+SDWLX I 'SDWLDFN Q
|
|
.;-Check for Institution Sort
|
|
.I SDWLINS'="ALL" D
|
|
..I '$D(SDWLIN(+$P(SDWLX,U,3))) S SDWLERR=1 Q
|
|
.I $P(SDWLX,U,16)'<DT,$P(SDWLX,U,16)'=DT S SDWLERR=2
|
|
.S SDWLAPDT=$P(SDWLX,U,16),SDWLOPDT=$P(SDWLX,U,2) S X1=DT,X2=SDWLAPDT D ^%DTC S SDWLDWT=+X
|
|
.S SDWLTYP=$P(SDWLCT1,U,1),SDWLTYPE=$S(SDWLTYP="C":+$P(SDWLX,U,9),1:+$P(SDWLX,U,8)) I SDWLTYPE=""!('SDWLTYPE) S SDWLERR=7 Q
|
|
.S SDWLF=$P(SDWLCT1,U,2)
|
|
.I SDWLCT2'="ALL" D
|
|
..I '$D(SDWLCT2(SDWLTYPE)) S SDWLERR=3
|
|
.I SDWLTYP="" S SDWLERR=4 Q
|
|
.I $P(SDWLX,U,17)["C" S SDWLERR=6 Q
|
|
.Q:SDWLERR D
|
|
..S SDWLSCC=2,DFN=SDWLDFN D ELIG^VADPT I $D(VAEL(3)) S SDWLSCN=$P(VAEL(3),U,2) I SDWLSCN>49 S SDWLSCC=1
|
|
..S:'$D(^TMP("SDWLROS",$J,"A",+$P(SDWLX,U,3),SDWLTYPE)) ^(SDWLTYPE)=0
|
|
..S ^TMP("SDWLROS",$J,"A",+$P(SDWLX,U,3),SDWLTYPE)=^(SDWLTYPE)+1
|
|
..S:'$D(^TMP("SDWLROS",$J,"B",+$P(SDWLX,U,3),SDWLTYPE,SDWLDFN)) ^(SDWLDFN)=0 S ^TMP("SDWLROS",$J,"B",+$P(SDWLX,U,3),SDWLTYPE,SDWLDFN)=^(SDWLDFN)+1
|
|
..S:'$D(^TMP("SDWLROS",$J,"C",SDWLSCC,+$P(SDWLX,U,3),SDWLTYPE)) ^TMP("SDWLROS",$J,"C",SDWLSCC,+$P(SDWLX,U,3),SDWLTYPE)=0
|
|
..S ^TMP("SDWLROS",$J,"C",SDWLSCC,+$P(SDWLX,U,3),SDWLTYPE)=^(SDWLTYPE)+1
|
|
..S ^TMP("SDWLROS",$J,"D",SDWLSCC,+$P(SDWLX,U,3),SDWLTYPE,SDWLDWT,SDWLDA)=""
|
|
Q
|
|
PRT ;
|
|
S SDWLIN=0 F S SDWLIN=$O(^TMP("SDWLROS",$J,"A",SDWLIN)) Q:SDWLIN="" W !,"Institution: ",$P($G(^DIC(4,SDWLIN,0)),U,1),! D
|
|
.D PRA
|
|
Q
|
|
PRA ;
|
|
S SDWLSC=0,(SDWLX,SDWLXT,SDWLXTT)=0 F S SDWLSC=$O(^TMP("SDWLROS",$J,"A",SDWLIN,SDWLSC)) Q:SDWLSC="" D
|
|
.S SDWLX=$G(^TMP("SDWLROS",$J,"A",SDWLIN,SDWLSC)),SDWLXT=SDWLXT+SDWLX W !,$$EXTERNAL^DILFD(SDWLF,.01,,$P(^SDWL(SDWLF,SDWLSC,0),U,1)),?30,SDWLX
|
|
.S SDWLDFNX=0 F S SDWLDFNX=$O(^TMP("SDWLROS",$J,"B",SDWLIN,SDWLSC,SDWLDFNX)) Q:SDWLDFNX="" S SDWLXTT=SDWLXTT+1
|
|
W !,?20,"Total #: ",SDWLXT
|
|
;W !,?4,"Total # Unique Patients: ",SDWLXTT,!!
|
|
I $D(SDWLSPT),$Y>IOSL S DIR(0)="E" D ^DIR I X="^" Q
|
|
Q
|
|
PRT1 ;
|
|
D HD,HD1
|
|
S SDWLSCC=0 F S SDWLSCC=$O(^TMP("SDWLROS",$J,"D",SDWLSCC)) Q:SDWLSCC="" Q:$$S^%ZTLOAD D I $D(DUOUT) Q
|
|
.W !,"******* ",SDWLSCC," *******",!
|
|
.S SDWLINS=0 F S SDWLINS=$O(^TMP("SDWLROS",$J,"D",SDWLSCC,SDWLINS)) Q:SDWLINS="" D W ! I $D(DUOUT) Q
|
|
..W !,$P($G(^DIC(4,SDWLINS,0)),U,1),!
|
|
..S SDWLSC=0 F S SDWLSC=$O(^TMP("SDWLROS",$J,"D",SDWLSCC,SDWLINS,SDWLSC)) Q:SDWLSC="" D I $D(DUOUT) Q
|
|
...W !,$$EXTERNAL^DILFD(SDWLF,.01,,$P(^SDWL(SDWLF,SDWLSC,0),U,1))
|
|
...S SDWLWT="" F S SDWLWT=$O(^TMP("SDWLROS",$J,"D",SDWLSCC,SDWLINS,SDWLSC,SDWLWT)) Q:SDWLWT="" D I $D(DUOUT) Q
|
|
....S SDWLDA=0 F S SDWLDA=$O(^TMP("SDWLROS",$J,"D",SDWLSCC,SDWLINS,SDWLSC,SDWLWT,SDWLDA)) Q:SDWLDA="" D I $D(DUOUT) Q
|
|
.....S X=$G(^SDWL(409.3,SDWLDA,0)),SDWLODT=$P(X,U,2),SDWLDDT=$P(X,U,16) D
|
|
......S DFN=+X D 1^VADPT,DEM^VADPT
|
|
......W !,VA("BID"),?6,$E(VADM(1),1,25),?32,$E(SDWLODT,4,5),"/",$E(SDWLODT,6,7),"/",($E(SDWLODT,1,3)+1700)
|
|
......W ?47,$E(SDWLDDT,4,5),"/",$E(SDWLDDT,6,7),"/",($E(SDWLDDT,1,3)+1700),?60,$J(SDWLWT,5) K VA,VADM
|
|
......I $D(SDWLSPT),$Y>(IOSL+3) S DIR(0)="E" D ^DIR I X="^" S DUOUT=1 Q
|
|
......I $Y>(IOSL+3) D HD,HD1
|
|
.W !
|
|
Q
|
|
LINE ;Draw Line
|
|
W !,"_______________________________________________________________________________"
|
|
Q
|
|
HD ;Header
|
|
W:$D(IOF) @IOF W !,SDWLDTP,?80-$L("Appointment Wait List Overdue Report")\2,"Appointment Wait List Overdue Report"
|
|
S Y=DT D DD^%DT S SDWLPD=Y W ?59,SDWLPD S SDWLPG=SDWLPG+1 W ?72,"Page: ",SDWLPG
|
|
W !!,?30,"Institution: " I SDWLINS="ALL" D
|
|
.W ?45,SDWLINS
|
|
F I=1:1 S X=$P($P(SDWLINS,";",I),"^",2) Q:X="" W:I>1 ! W ?45,X
|
|
S X=$P(SDWLCT1,U,1)
|
|
W !?27,"Report Category: ",$S($P(SDWLCT1,U,1)="C":"CLINIC",1:"SPECIALTY") I X="ALL" W " ALL"
|
|
I X'="ALL" D
|
|
.F I=1:1 S X=$P($P(SDWLCT2,";",I),"^",2) Q:X="" W !,?45,$$EXTERNAL^DILFD(SDWLF,.01,,X)
|
|
S X=$G(SDWLFORM) W !,?28,"Output Format: ",$S(SDWLFORM="S":"Summary",1:"Detailed")
|
|
Q
|
|
HD1 ;
|
|
W !!,"Name",?30,"Date Entered",?45,"Date Desired",?60,"# of Days Waiting",!!
|
|
Q
|
|
END K X1,X2,SDWLAPDT,CT,CT1,CT2,I,OPEN,INS,FORM,VADM Q
|