SDWLRPT1 ;;IOFO BAY PINES/TEH - WAIT LIST REPORT FORMAT 1;06/12/2002 ; 29 Aug 2002 2:54 PM ;;5.3;scheduling;**263,399,394**;AUG 13 1993 ; ; ;****************************************************************** ; CHANGE LOG ; ; DATE PATCH DESCRIPTION ; ---- ----- ----------- ; ; ; ; EN D INIT I $$S^%ZTLOAD G END D SORT I $$S^%ZTLOAD G END D PRINT I $$S^%ZTLOAD G END K ^TMP("SDWLRPT1",$J),^TMP("SDWLRQ1",$J) Q INIT ;Initialize variables ; I $D(CT1) S SDWLCT1=CT1 I $D(CT2) S SDWLCT2=CT2 I $D(DATE) S SDWLDATE=DATE I $D(FORM) S SDWLFORM=FORM I $D(INS) S SDWLINS=INS I $D(OPEN) S SDWLOPEN=OPEN S SDWLPG=0 I $D(ZTSAVE) D .F SDWLI="CT1","CT2","DATE","FORM","INS","OPEN" S SDWL="SDWL"_SDWLI,@SDWL=$G(ZTSAVE(SDWLI)) I SDWLINS="ALL" S SDWLIN("ALL")="" S SDWLTXP=$P(SDWLCT1,U,3) S SDWLOPEN=$S(SDWLOPEN=1:"O",1:"C") I SDWLINS'="ALL" F SDWLI=1:1 S SDWLIN=$P($P(SDWLINS,";",SDWLI),U,1) Q:SDWLIN="" S SDWLIN(SDWLIN)="",^TMP("SDWLRPT1",$J,$P(^DIC(4,SDWLIN,0),U,1))=0 I SDWLCT2'="ALL" F SDWLI=1:1 S SDWLCT=$P($P(SDWLCT2,";",SDWLI),U,1) Q:SDWLCT="" S SDWLCT2(SDWLCT)="" I SDWLDATE="ALL" S SDWLBD=0,SDWLED=9999999 G INIT1 S SDWLBD=$P(SDWLDATE,U,1),SDWLED=$P(SDWLDATE,U,2) INIT1 D NOW^%DTC S Y=% D DD^%DT S SDWLDTP=$P(Y,":",1,2) Q SORT ;Sort Records S SDWLDA=0,SDWLCNT=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 .;-Check for Institution Sort .I SDWLINS'="ALL" D ..I '$D(SDWLIN(+$P(SDWLX,U,3))) S SDWLERR=1 Q .;-Check for Date Range Compliance .I $P(SDWLX,U,16)SDWLED) S SDWLERR=2 Q .S SDWLTYP=$P(SDWLCT1,U,1),SDWLTYPE=$S(SDWLTYP="C":$P(SDWLX,U,9),1:$P(SDWLX,U,8)) I SDWLTYPE="" S SDWLERR=7 Q .I SDWLCT2'="ALL" D ..I '$D(SDWLCT2(SDWLTYPE)) S SDWLERR=3 .I SDWLTYP="" S SDWLERR=4 Q .I $P(SDWLX,U,3)=""!($P(SDWLX,U,16)="") S SDWLERR=5 Q .I SDWLOPEN'["C",$P(SDWLX,U,17)'[SDWLOPEN 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 SDWLF=$P(SDWLCT1,U,2) ..S SDWLIENS=$P(SDWLX,U,3)_",",X=$$GET1^DIQ(4,SDWLIENS,".01") ..S SDWLSIEN=SDWLTYPE_",",Y=$$GET1^DIQ(SDWLF,SDWLSIEN,".01") ..S ^TMP("SDWLRPT1",$J,X,Y,SDWLSCC,+$P(SDWLX,U,16),SDWLDA)="" ..S SDWLCNT=SDWLCNT+1,^TMP("SDWLRPT1",$J,$P(^DIC(4,+$P(SDWLX,U,3),0),U,1))=SDWLCNT Q PRINT ;Print Report N DFN D HD S SDWLCNT=0 I '$D(^TMP("SDWLRPT1",$J)) W !!,?80-$L("*** No Patient Records to Report ***")\2,"*** No Patient Records to Report ***" Q S SDWLA="" F S SDWLA=$O(^TMP("SDWLRPT1",$J,SDWLA)) G END:$$S^%ZTLOAD Q:SDWLA="" D Q:$D(DUOUT) .D LINE W !!,"Institution: " S X=SDWLA W X I '$G(^TMP("SDWLRPT1",$J,SDWLA)) W !!,"*** No Patient Records to Report ***" .S SDWLB="" F S SDWLB=$O(^TMP("SDWLRPT1",$J,SDWLA,SDWLB)) Q:SDWLB="" D Q:$D(DUOUT) ..W !!,"Clinic/Service: " S X=SDWLB W X,! Q:$D(DUOUT) ..S SDWLC="" F S SDWLC=$O(^TMP("SDWLRPT1",$J,SDWLA,SDWLB,SDWLC)) Q:SDWLC="" D Q:$D(DUOUT) ...S SDWLD="" F S SDWLD=$O(^TMP("SDWLRPT1",$J,SDWLA,SDWLB,SDWLC,SDWLD)) Q:SDWLD="" D Q:$D(DUOUT) ....S SDWLE="" F S SDWLE=$O(^TMP("SDWLRPT1",$J,SDWLA,SDWLB,SDWLC,SDWLD,SDWLE)) Q:SDWLE="" D Q:$D(DUOUT) .....S SDWLDFN=$P($G(^SDWL(409.3,SDWLE,0)),U,1),DFN=SDWLDFN D DEM^VADPT,ELIG^VADPT,ADD^VADPT .....S SDWLNAM=VADM(1),SDWLELIG=VAEL(1) I SDWLELIG="" S SDWLELIG=0 .....I SDWLELIG=0 S SDWLELIG="No Eligibility Status found" .....S SDWLDEAD=1 .....S SDWLSSN=VA("BID"),SDWLAPTD=$P(^SDWL(409.3,SDWLE,0),U,16),SDWLCOM=$P(^SDWL(409.3,SDWLE,0),U,18) .....S SDWLRBY=$P(^SDWL(409.3,SDWLE,0),U,12),SDWLRPV=$P(^SDWL(409.3,SDWLE,0),U,13) .....S SDWLPH=$G(VAPA(8)) I SDWLAPTD'="" S Y=SDWLAPTD D DD^%DT S SDWLAPTD=Y .....W !!,SDWLNAM .....W ?35,SDWLSSN I SDWLAPTD'="" W ?50,"Desired Date: ",SDWLAPTD .....W !,"Primary Eligibility: ",$P(SDWLELIG,U,2) .....;PATCH SD*5.3*394 See Note. .....N SDWLSCP .....W !,"Service Connected Priority: " S SDWLSCP=$$GET1^DIQ(409.3,SDWLE_",",15,"I") W $S(SDWLSCP=1:"YES",1:"NO") .....W !,"Comments: ",SDWLCOM,! .....I SDWLRBY W !,"Requested by: ",$$EXTERNAL^DILFD(409.3,11,,SDWLRBY) .....I SDWLRPV W ?35,"Requesting Provider: " S X=$$EXTERNAL^DILFD(409.3,12,,SDWLRPV) W X .....W !,"Telephone (Home): ",$P(SDWLPH,U,1) I $P(SDWLPH,U,2) W !,?10,"(Work): ",$P(SDWLPH,U,2) .....I $D(^SDWL(409.3,SDWLE,"DIS")) D ......S SDWLDISX=$G(^SDWL(409.3,SDWLE,"DIS")),SDWLDIS=$P(SDWLDISX,U,3),SDWLDDUZ=$P(SDWLDISX,U,2) ......S SDWLDDT=$P(^SDWL(409.3,SDWLE,"DIS"),U,1),SDWLDIDT=$E(SDWLDDT,4,5)_"/"_$E(SDWLDDT,6,7)_"/"_$E(SDWLDDT,2,3) .....I $D(SDWLDISX) W !,"Disposition: ",$P(SDWLDISX,U,3)," (",SDWLDIDT,")" K SDWLDISX,SDWLDIS,SDWLDDUZ,SDWLDIDT .....W !,"*****" .....I $D(SDWLSPT),$Y>IOSL S DIR(0)="E" D ^DIR I X["^" S DUOUT=1 Q .....I '$D(SDWLSPT),'$D(DUOUT),$Y>(IOSL-5) D HD W !!,"** End of Report **" Q LINE ;Draw Line W !,"_______________________________________________________________________________" Q HD ;Header W:$D(IOF) @IOF W !,SDWLDTP,?80-$L("Appointment Wait List Report")\2,"Appointment Wait List Report" 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 Y=$P(SDWLDATE,U,1) D DD^%DT S SDWLBDT=Y S Y=$P(SDWLDATE,U,2) D DD^%DT S SDWLEDT=Y W !,?23,"Date Desired Range: ",SDWLBDT I SDWLEDT'="" W " to ",SDWLEDT S X=$P(SDWLCT2,U,2) W !?26,"Report Category: ",$S($P(SDWLCT1,U,1)="C":"CLINIC",1:"SPECIALTY") I X="ALL" W " ALL" S SDWLF=$P(SDWLCT1,U,1) I X'="ALL" D .F I=1:1 S X=$P($P(SDWLCT2,";",I),"^",2) Q:X="" W !,?45,$S(SDWLF="C":$P(^SC(X,0),U,1),1:$P(^DIC(40.7,X,0),U,1)) S X=$G(SDWLOPEN) W !,?35,"Status: ",$S(SDWLOPEN="O":"Open",1:"All") S X=$G(SDWLFORM) W !,?28,"Output Format: ",$S(SDWLFORM="S":"Summary",1:"Detailed") Q END K SDWL,SDWLA,SDWLAPTD,SDWLB,SDWLBD,SDWLBDT,SDWLC,SDWLCAT,SDWLCNT,SDWLCOM,SDWLCT1,SDWLCT2,SDWLCTX,SDWLD K SDLWDA,SDLWDEAD,SDWLDFN,SDWLE,SDWLEDT,SDWLELIG,SDWLERR,SDWLF,SDWLFD,SDWLI,SDWLIN,SDWLINS,SDWLINST K SDWLNAM,SDWLPD,SDWLPG,SDWLPH,SDWLPROM,SDWLRBY,SDWLPRV,SDWLSCC,SDWLSPT,SDWLSSN,SDWLTAG,SDLTK,SDWLTXP K SDWLTYP,SDWLTYPE,SDWLX,VDAM,VAPA,SDWLIENS,CT1,CT2,DATE,I,INS,OPEN,FORM,SDWLSIEN D EN^SDWLKIL Q