source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDWLRPT2.m@ 1796

Last change on this file since 1796 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 5.3 KB
Line 
1SDWLRPT2 ;;IOFO BAY PINES/TEH - WAIT LIST REPORT FORMAT 2 (PCMM);06/12/2002 ; 29 Aug 2002 2:54 PM
2 ;;5.3;scheduling;**263**;AUG 13 1993
3 ;
4 ;
5 ;******************************************************************
6 ; CHANGE LOG
7 ;
8 ; DATE PATCH DESCRIPTION
9 ; ---- ----- -----------
10 ;
11 ;
12 ;
13 ;
14EN ;
15 D INIT
16 D SORT
17 I $$S^%ZTLOAD G END
18 D PRINT
19 I $$S^%ZTLOAD G END
20 K ^TMP("SDWLRPT2",$J)
21 Q
22INIT ;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","PRI" S SDWL="SDWL"_SDWLI,@SDWL=$G(ZTSAVE(SDWLI))
33 I SDWLINS="ALL" S SDWLIN("ALL")=""
34 S SDWLTXP=$P(SDWLCT1,U,3)
35 I SDWLINS'="ALL" F SDWLI=1:1 S SDWLIN=$P($P(SDWLINS,";",SDWLI),U,1) Q:SDWLIN="" S SDWLIN(SDWLIN)="",^TMP("SDWLRPT2",$J,$P(^DIC(4,SDWLIN,0),U,1))=0
36 I SDWLCT2'="ALL" F SDWLI=1:1 S SDWLCT=$P($P(SDWLCT2,";",SDWLI),U,1) Q:SDWLCT="" S SDWLCT2(SDWLCT)=""
37 I '$D(SDWLDATE) S SDWLBD=0,SDWLED=9999999 G INIT1
38 I SDWLDATE="ALL" S SDWLBD=0,SDWLED=9999999 G INIT1
39 S SDWLBD=$P(SDWLDATE,U,1),SDWLED=$P(SDWLDATE,U,2)
40INIT1 D NOW^%DTC S Y=% D DD^%DT S SDWLDTP=$P(Y,":",1,2)
41 Q
42SORT ;Sort Records
43 K ^TMP("SDWLRPT2",$J) S SDWLCNT=0
44 S SDWLDA=0 F S SDWLDA=$O(^SDWL(409.3,SDWLDA)) Q:SDWLDA<1 D
45 .S SDWLX=$G(^SDWL(409.3,SDWLDA,0)),SDWLERR=0,SDWLDFN=+SDWLX
46 .;-Check for Institution Sort
47 .I SDWLINS'="ALL" D
48 ..I '$D(SDWLIN(+$P(SDWLX,U,3))) S SDWLERR=1 Q
49 .S SDWLTY1=$P(SDWLX,U,5)
50 .S SDWLTYP=$P(SDWLCT1,U,1)
51 .S SDWLTY2=$S(SDWLTYP="T":1,1:2) I SDWLTY1'=SDWLTY2 S SDWLERR=10
52 .S SDWLTYPE=$S(SDWLTYP="T":$P(SDWLX,U,6),1:$P(SDWLX,U,7)) I SDWLTYPE=""!('SDWLTYPE) S SDWLERR=7 Q
53 .S SDWLFLD=$S(SDWLTYP="T":5,1:6)
54 .I SDWLCT2'="ALL" D
55 ..I '$D(SDWLCT2(SDWLTYPE)) S SDWLERR=3
56 .I SDWLTYP="" S SDWLERR=4 Q
57 .I SDWLOPEN'["C",$P(SDWLX,U,17)'[SDWLOPEN S SDWLERR=6 Q
58 .Q:SDWLERR D
59 ..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
60 ..S SDWLF=$P(SDWLCT1,U,2),SDWLIENS=+$P(SDWLX,U,3)_",",SDWLIX=$$GET1^DIQ(4,SDWLIENS,".01")
61 ..S SDWLSIEN=SDWLTYPE_",",Y=$$GET1^DIQ(SDWLF,SDWLSIEN,".01")
62 ..S ^TMP("SDWLRPT2",$J,SDWLIX,Y,SDWLSCC,SDWLDA)=""
63 ..S SDWLCNT=SDWLCNT+1,^TMP("SDWLRPT2",$J,$P(^DIC(4,$P(SDWLX,U,3),0),U,1))=SDWLCNT
64 Q
65PRINT ;Print Report
66 S SDWLCNT=0 D HD I '$D(^TMP("SDWLRPT2",$J)) W !!,?80-$L("*** No Patient Records to Report ***")\2,"*** No Patient Records to Report ***" Q
67 S SDWLA="" F S SDWLA=$O(^TMP("SDWLRPT2",$J,SDWLA)) G END:$$S^%ZTLOAD Q:SDWLA="" D Q:$D(DUOUT)
68 .D LINE W !!,"Institution: " W SDWLA I '$G(^TMP("SDWLRPT2",$J,SDWLA)) W !!,"*** No Patient Records to Report ***"
69 .S SDWLB="" F S SDWLB=$O(^TMP("SDWLRPT2",$J,SDWLA,SDWLB)) Q:SDWLB="" D Q:$D(DUOUT)
70 ..W !!,"Team/Position: " W SDWLB,!
71 ..S SDWLC="" F S SDWLC=$O(^TMP("SDWLRPT2",$J,SDWLA,SDWLB,SDWLC)) Q:SDWLC="" D Q:$D(DUOUT)
72 ...S SDWLD="" F S SDWLD=$O(^TMP("SDWLRPT2",$J,SDWLA,SDWLB,SDWLC,SDWLD)) Q:SDWLD="" D Q:$D(DUOUT)
73 ....S SDWLDFN=$P($G(^SDWL(409.3,SDWLD,0)),U,1),DFN=SDWLDFN D DEM^VADPT,ELIG^VADPT,ADD^VADPT
74 ....S SDWLNAM=VADM(1),SDWLELIG=VAEL(1) I SDWLELIG="" S SDWLELIG=0
75 ....S SDWLODT=$P($G(^SDWL(409.3,SDWLD,0)),U,2) S Y=SDWLODT D DD^%DT S SDWLODT=Y
76 ....S SDWLDEAD=1
77 ....S SDWLSSN=VA("BID"),SDWLAPTD=$P(^SDWL(409.3,SDWLD,0),U,16),SDWLCOM=$P(^SDWL(409.3,SDWLD,0),U,18)
78 ....S SDWLRBY=$P(^SDWL(409.3,SDWLD,0),U,12),SDWLRPV=$P(^SDWL(409.3,SDWLD,0),U,13)
79 ....S SDWLPH=$G(VAPA(8)) I SDWLAPTD'="" S Y=SDWLAPTD D DD^%DT S SDWLAPTD=Y
80 ....W !!,SDWLNAM,?40,SDWLSSN,?50,"Date Entered: ",SDWLODT
81 ....W !,"Primary Eligibility: ",$P(SDWLELIG,U,2)
82 ....W !,"Comments: ",SDWLCOM,!
83 ....I SDWLRBY W !,"Requested by: ",$$EXTERNAL^DILFD(409.3,11,,SDWLRBY)
84 ....I SDWLRPV W ?35,"Requesting Provider: " S X=$$EXTERNAL^DILFD(409.3,12,,SDWLRPV) W X
85 ....W !,"Telephone (Home): ",$P(SDWLPH,U,1) I $P(SDWLPH,U,2) W !,?10,"(Work): ",$P(SDWLPH,U,2)
86 ....I $D(^SDWL(409.3,SDWLD,"DIS")) D
87 .....S SDWLDISX=$G(^SDWL(409.3,SDWLD,"DIS")),SDWLDIS=$P(SDWLDISX,U,3),SDWLDDUZ=$P(SDWLDISX,U,2)
88 .....S SDWLDDT=$P(^SDWL(409.3,SDWLD,"DIS"),U,1),SDWLDIDT=$E(SDWLDDT,4,5)_"/"_$E(SDWLDDT,6,7)_"/"_$E(SDWLDDT,2,3)
89 .....I $D(SDWLDISX) W !,"Disposition: ",$P(SDWLDISX,U,3)," (",SDWLDIDT,")" K SDWLDISX,SDWLDIS,SDWLDDUZ,SDWLDIDT
90 ....W !,"*****"
91 ....I $D(SDWLSPT),$Y>(IOSL-3) S DIR(0)="E" D ^DIR I X["^" S DUOUT=1
92 ....I '$D(SDWLSPT),$Y>(IOSL-5) D HD
93 W !!,"** End of Report **"
94 Q
95LINE ;Draw Line
96 W !,"_______________________________________________________________________________"
97 Q
98HD ;Header
99 W:$D(IOF) @IOF W !,SDWLDTP,?80-$L("PCMM Team/Position Wait List Report")\2,"PCMM Team/Position Wait List Report"
100 S SDWLPG=SDWLPG+1 W ?72,"Page: ",SDWLPG
101 W !!,?30,"Institution: " I SDWLINS="ALL" D
102 .W ?45,SDWLINS
103 F I=1:1 S X=$P(SDWLINS,";",I) Q:X="" S SDWLIENS=X_"," W:I>1 ! W ?45,$$GET1^DIQ(4,SDWLIENS,".01")
104 S X=$P(SDWLCT2,U,2)
105 W !?26,"Report Category: ",$S($P(SDWLCT1,U,1)="T":"TEAM",1:"POSITION") I X="ALL" W " ALL"
106 I X'="ALL" D
107 .F I=1:1 S X=$P($P(SDWLCT2,";",I),"^",2) Q:X="" W !,?45,X
108 S X=$G(SDWLOPEN) W !,?35,"Status: ",$S(SDWLOPEN="O":"Open",1:"All")
109 S X=$G(SDWLFORM) W !,?28,"Output Format: ",$S(SDWLFORM="S":"Summary",1:"Detailed")
110 Q
111END D EN^SDWLKIL K VADM,VAPA,SDWLIENS,SDWLIX,CT1,CT2,DATE,I,INS,OPEN,FORM,SDWLSIEN
112 Q
Note: See TracBrowser for help on using the repository browser.