| 1 | SDWLRPT1 ;;IOFO BAY PINES/TEH - WAIT LIST REPORT FORMAT 1;06/12/2002 ; 29 Aug 2002 2:54 PM
|
|---|
| 2 | ;;5.3;scheduling;**263,399,394**;AUG 13 1993
|
|---|
| 3 | ;
|
|---|
| 4 | ;
|
|---|
| 5 | ;******************************************************************
|
|---|
| 6 | ; CHANGE LOG
|
|---|
| 7 | ;
|
|---|
| 8 | ; DATE PATCH DESCRIPTION
|
|---|
| 9 | ; ---- ----- -----------
|
|---|
| 10 | ;
|
|---|
| 11 | ;
|
|---|
| 12 | ;
|
|---|
| 13 | ;
|
|---|
| 14 | EN D INIT
|
|---|
| 15 | I $$S^%ZTLOAD G END
|
|---|
| 16 | D SORT
|
|---|
| 17 | I $$S^%ZTLOAD G END
|
|---|
| 18 | D PRINT
|
|---|
| 19 | I $$S^%ZTLOAD G END
|
|---|
| 20 | K ^TMP("SDWLRPT1",$J),^TMP("SDWLRQ1",$J)
|
|---|
| 21 | Q
|
|---|
| 22 | INIT ;Initialize variables
|
|---|
| 23 | ;
|
|---|
| 24 | I $D(CT1) S SDWLCT1=CT1
|
|---|
| 25 | I $D(CT2) S SDWLCT2=CT2
|
|---|
| 26 | I $D(DATE) S SDWLDATE=DATE
|
|---|
| 27 | I $D(FORM) S SDWLFORM=FORM
|
|---|
| 28 | I $D(INS) S SDWLINS=INS
|
|---|
| 29 | I $D(OPEN) S SDWLOPEN=OPEN
|
|---|
| 30 | S SDWLPG=0
|
|---|
| 31 | I $D(ZTSAVE) D
|
|---|
| 32 | .F SDWLI="CT1","CT2","DATE","FORM","INS","OPEN" S SDWL="SDWL"_SDWLI,@SDWL=$G(ZTSAVE(SDWLI))
|
|---|
| 33 | I SDWLINS="ALL" S SDWLIN("ALL")=""
|
|---|
| 34 | S SDWLTXP=$P(SDWLCT1,U,3)
|
|---|
| 35 | S SDWLOPEN=$S(SDWLOPEN=1:"O",1:"C")
|
|---|
| 36 | 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
|
|---|
| 37 | I SDWLCT2'="ALL" F SDWLI=1:1 S SDWLCT=$P($P(SDWLCT2,";",SDWLI),U,1) Q:SDWLCT="" S SDWLCT2(SDWLCT)=""
|
|---|
| 38 | I SDWLDATE="ALL" S SDWLBD=0,SDWLED=9999999 G INIT1
|
|---|
| 39 | S SDWLBD=$P(SDWLDATE,U,1),SDWLED=$P(SDWLDATE,U,2)
|
|---|
| 40 | INIT1 D NOW^%DTC S Y=% D DD^%DT S SDWLDTP=$P(Y,":",1,2)
|
|---|
| 41 | Q
|
|---|
| 42 | SORT ;Sort Records
|
|---|
| 43 | S SDWLDA=0,SDWLCNT=0 F S SDWLDA=$O(^SDWL(409.3,SDWLDA)) Q:SDWLDA<1 D
|
|---|
| 44 | .S SDWLX=$G(^SDWL(409.3,SDWLDA,0)),SDWLERR=0,SDWLDFN=+SDWLX
|
|---|
| 45 | .;-Check for Institution Sort
|
|---|
| 46 | .I SDWLINS'="ALL" D
|
|---|
| 47 | ..I '$D(SDWLIN(+$P(SDWLX,U,3))) S SDWLERR=1 Q
|
|---|
| 48 | .;-Check for Date Range Compliance
|
|---|
| 49 | .I $P(SDWLX,U,16)<SDWLBD!($P(SDWLX,U,16)>SDWLED) S SDWLERR=2 Q
|
|---|
| 50 | .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
|
|---|
| 51 | .I SDWLCT2'="ALL" D
|
|---|
| 52 | ..I '$D(SDWLCT2(SDWLTYPE)) S SDWLERR=3
|
|---|
| 53 | .I SDWLTYP="" S SDWLERR=4 Q
|
|---|
| 54 | .I $P(SDWLX,U,3)=""!($P(SDWLX,U,16)="") S SDWLERR=5 Q
|
|---|
| 55 | .I SDWLOPEN'["C",$P(SDWLX,U,17)'[SDWLOPEN S SDWLERR=6 Q
|
|---|
| 56 | .Q:SDWLERR D
|
|---|
| 57 | ..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
|
|---|
| 58 | ..S SDWLF=$P(SDWLCT1,U,2)
|
|---|
| 59 | ..S SDWLIENS=$P(SDWLX,U,3)_",",X=$$GET1^DIQ(4,SDWLIENS,".01")
|
|---|
| 60 | ..S SDWLSIEN=SDWLTYPE_",",Y=$$GET1^DIQ(SDWLF,SDWLSIEN,".01")
|
|---|
| 61 | ..S ^TMP("SDWLRPT1",$J,X,Y,SDWLSCC,+$P(SDWLX,U,16),SDWLDA)=""
|
|---|
| 62 | ..S SDWLCNT=SDWLCNT+1,^TMP("SDWLRPT1",$J,$P(^DIC(4,+$P(SDWLX,U,3),0),U,1))=SDWLCNT
|
|---|
| 63 | Q
|
|---|
| 64 | PRINT ;Print Report
|
|---|
| 65 | N DFN
|
|---|
| 66 | 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
|
|---|
| 67 | S SDWLA="" F S SDWLA=$O(^TMP("SDWLRPT1",$J,SDWLA)) G END:$$S^%ZTLOAD Q:SDWLA="" D Q:$D(DUOUT)
|
|---|
| 68 | .D LINE W !!,"Institution: " S X=SDWLA W X I '$G(^TMP("SDWLRPT1",$J,SDWLA)) W !!,"*** No Patient Records to Report ***"
|
|---|
| 69 | .S SDWLB="" F S SDWLB=$O(^TMP("SDWLRPT1",$J,SDWLA,SDWLB)) Q:SDWLB="" D Q:$D(DUOUT)
|
|---|
| 70 | ..W !!,"Clinic/Service: " S X=SDWLB W X,! Q:$D(DUOUT)
|
|---|
| 71 | ..S SDWLC="" F S SDWLC=$O(^TMP("SDWLRPT1",$J,SDWLA,SDWLB,SDWLC)) Q:SDWLC="" D Q:$D(DUOUT)
|
|---|
| 72 | ...S SDWLD="" F S SDWLD=$O(^TMP("SDWLRPT1",$J,SDWLA,SDWLB,SDWLC,SDWLD)) Q:SDWLD="" D Q:$D(DUOUT)
|
|---|
| 73 | ....S SDWLE="" F S SDWLE=$O(^TMP("SDWLRPT1",$J,SDWLA,SDWLB,SDWLC,SDWLD,SDWLE)) Q:SDWLE="" D Q:$D(DUOUT)
|
|---|
| 74 | .....S SDWLDFN=$P($G(^SDWL(409.3,SDWLE,0)),U,1),DFN=SDWLDFN D DEM^VADPT,ELIG^VADPT,ADD^VADPT
|
|---|
| 75 | .....S SDWLNAM=VADM(1),SDWLELIG=VAEL(1) I SDWLELIG="" S SDWLELIG=0
|
|---|
| 76 | .....I SDWLELIG=0 S SDWLELIG="No Eligibility Status found"
|
|---|
| 77 | .....S SDWLDEAD=1
|
|---|
| 78 | .....S SDWLSSN=VA("BID"),SDWLAPTD=$P(^SDWL(409.3,SDWLE,0),U,16),SDWLCOM=$P(^SDWL(409.3,SDWLE,0),U,18)
|
|---|
| 79 | .....S SDWLRBY=$P(^SDWL(409.3,SDWLE,0),U,12),SDWLRPV=$P(^SDWL(409.3,SDWLE,0),U,13)
|
|---|
| 80 | .....S SDWLPH=$G(VAPA(8)) I SDWLAPTD'="" S Y=SDWLAPTD D DD^%DT S SDWLAPTD=Y
|
|---|
| 81 | .....W !!,SDWLNAM
|
|---|
| 82 | .....W ?35,SDWLSSN I SDWLAPTD'="" W ?50,"Desired Date: ",SDWLAPTD
|
|---|
| 83 | .....W !,"Primary Eligibility: ",$P(SDWLELIG,U,2)
|
|---|
| 84 | .....;PATCH SD*5.3*394 See Note.
|
|---|
| 85 | .....N SDWLSCP
|
|---|
| 86 | .....W !,"Service Connected Priority: " S SDWLSCP=$$GET1^DIQ(409.3,SDWLE_",",15,"I") W $S(SDWLSCP=1:"YES",1:"NO")
|
|---|
| 87 | .....W !,"Comments: ",SDWLCOM,!
|
|---|
| 88 | .....I SDWLRBY W !,"Requested by: ",$$EXTERNAL^DILFD(409.3,11,,SDWLRBY)
|
|---|
| 89 | .....I SDWLRPV W ?35,"Requesting Provider: " S X=$$EXTERNAL^DILFD(409.3,12,,SDWLRPV) W X
|
|---|
| 90 | .....W !,"Telephone (Home): ",$P(SDWLPH,U,1) I $P(SDWLPH,U,2) W !,?10,"(Work): ",$P(SDWLPH,U,2)
|
|---|
| 91 | .....I $D(^SDWL(409.3,SDWLE,"DIS")) D
|
|---|
| 92 | ......S SDWLDISX=$G(^SDWL(409.3,SDWLE,"DIS")),SDWLDIS=$P(SDWLDISX,U,3),SDWLDDUZ=$P(SDWLDISX,U,2)
|
|---|
| 93 | ......S SDWLDDT=$P(^SDWL(409.3,SDWLE,"DIS"),U,1),SDWLDIDT=$E(SDWLDDT,4,5)_"/"_$E(SDWLDDT,6,7)_"/"_$E(SDWLDDT,2,3)
|
|---|
| 94 | .....I $D(SDWLDISX) W !,"Disposition: ",$P(SDWLDISX,U,3)," (",SDWLDIDT,")" K SDWLDISX,SDWLDIS,SDWLDDUZ,SDWLDIDT
|
|---|
| 95 | .....W !,"*****"
|
|---|
| 96 | .....I $D(SDWLSPT),$Y>IOSL S DIR(0)="E" D ^DIR I X["^" S DUOUT=1 Q
|
|---|
| 97 | .....I '$D(SDWLSPT),'$D(DUOUT),$Y>(IOSL-5) D HD
|
|---|
| 98 | W !!,"** End of Report **"
|
|---|
| 99 | Q
|
|---|
| 100 | LINE ;Draw Line
|
|---|
| 101 | W !,"_______________________________________________________________________________"
|
|---|
| 102 | Q
|
|---|
| 103 | HD ;Header
|
|---|
| 104 | W:$D(IOF) @IOF W !,SDWLDTP,?80-$L("Appointment Wait List Report")\2,"Appointment Wait List Report"
|
|---|
| 105 | S SDWLPG=SDWLPG+1 W ?72,"Page: ",SDWLPG
|
|---|
| 106 | W !!,?30,"Institution: " I SDWLINS="ALL" D
|
|---|
| 107 | .W ?45,SDWLINS
|
|---|
| 108 | F I=1:1 S X=$P($P(SDWLINS,";",I),"^",2) Q:X="" W:I>1 ! W ?45,X
|
|---|
| 109 | S Y=$P(SDWLDATE,U,1) D DD^%DT S SDWLBDT=Y S Y=$P(SDWLDATE,U,2) D DD^%DT S SDWLEDT=Y
|
|---|
| 110 | W !,?23,"Date Desired Range: ",SDWLBDT
|
|---|
| 111 | I SDWLEDT'="" W " to ",SDWLEDT
|
|---|
| 112 | S X=$P(SDWLCT2,U,2)
|
|---|
| 113 | W !?26,"Report Category: ",$S($P(SDWLCT1,U,1)="C":"CLINIC",1:"SPECIALTY") I X="ALL" W " ALL"
|
|---|
| 114 | S SDWLF=$P(SDWLCT1,U,1)
|
|---|
| 115 | I X'="ALL" D
|
|---|
| 116 | .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))
|
|---|
| 117 | S X=$G(SDWLOPEN) W !,?35,"Status: ",$S(SDWLOPEN="O":"Open",1:"All")
|
|---|
| 118 | S X=$G(SDWLFORM) W !,?28,"Output Format: ",$S(SDWLFORM="S":"Summary",1:"Detailed")
|
|---|
| 119 | Q
|
|---|
| 120 | END K SDWL,SDWLA,SDWLAPTD,SDWLB,SDWLBD,SDWLBDT,SDWLC,SDWLCAT,SDWLCNT,SDWLCOM,SDWLCT1,SDWLCT2,SDWLCTX,SDWLD
|
|---|
| 121 | K SDLWDA,SDLWDEAD,SDWLDFN,SDWLE,SDWLEDT,SDWLELIG,SDWLERR,SDWLF,SDWLFD,SDWLI,SDWLIN,SDWLINS,SDWLINST
|
|---|
| 122 | K SDWLNAM,SDWLPD,SDWLPG,SDWLPH,SDWLPROM,SDWLRBY,SDWLPRV,SDWLSCC,SDWLSPT,SDWLSSN,SDWLTAG,SDLTK,SDWLTXP
|
|---|
| 123 | K SDWLTYP,SDWLTYPE,SDWLX,VDAM,VAPA,SDWLIENS,CT1,CT2,DATE,I,INS,OPEN,FORM,SDWLSIEN
|
|---|
| 124 | D EN^SDWLKIL
|
|---|
| 125 | Q
|
|---|
