source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDWLRPT1.m@ 861

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)<SDWLBD!($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