1 | SDWLR31 ;BPOI/TEH - WAIT LIST REPORT 30/120 (PCMM) PRINT;06/12/2002
|
---|
2 | ;;5.3;scheduling;**524**;AUG 13 1993;Build 29
|
---|
3 | ;
|
---|
4 | ;
|
---|
5 | ;
|
---|
6 | ;
|
---|
7 | ;
|
---|
8 | Q
|
---|
9 | EN ;ENTRY POINT
|
---|
10 | Q:'$D(^TMP("SDWLR30")) K ^TMP("SDWLR31",$J)
|
---|
11 | S SDWLJOB=$G(^TMP("SDWLR30","JOB")) Q:SDWLJOB=""
|
---|
12 | I '$D(^TMP("SDWLR30",SDWLJOB)) Q
|
---|
13 | S %H=+$H D YMD^%DTC S SDWLDT=X
|
---|
14 | D SORT
|
---|
15 | D PRINT
|
---|
16 | K SDWLJOB,SDWLDT,SDWLINS,SDWLDATE,SDWLOPEN,X,S1,S2,S3,S1T,S2T,S3T,SDWLDA
|
---|
17 | K SDWLTY,SDWLTYP,SDWLFL,SDWLFLG
|
---|
18 | Q
|
---|
19 | SORT S (SDWLINS,SDWLDATE,SDWLOPEN)="" F X="INS","DATE","OPEN" I $D(^TMP("SDWLR30",SDWLJOB,X)) D
|
---|
20 | . S @("SDWL"_X)=$G(^TMP("SDWLR30",SDWLJOB,X))
|
---|
21 | A0 I '$D(SDWLINS) Q
|
---|
22 | A1 I '$D(SDWLDATE) Q
|
---|
23 | A2 I '$D(SDWLOPEN) Q
|
---|
24 | I SDWLDATE'="ALL" S SDWLDATB=$P(SDWLDATE,U),SDWLDATE=$P(SDWLDATE,U,2)
|
---|
25 | A3 S SDWLDA=0 F S SDWLDA=$O(^SDWL(409.3,SDWLDA)) Q:SDWLDA<1 D
|
---|
26 | . S SDWLX=$G(^SDWL(409.3,SDWLDA,0))
|
---|
27 | . S SDWLIN=+$P(SDWLX,U,3) I SDWLINS'="ALL",SDWLINS'[SDWLIN Q
|
---|
28 | . S SDWLTY=+$P(SDWLX,U,5)
|
---|
29 | . S SDWLTYP=+$S(SDWLTY=1:$P(SDWLX,U,6),SDWLTY=2:$P(SDWLX,U,7),SDWLTY=3:$P(SDWLX,U,8),SDWLTY=4:$P(SDWLX,U,9),1:0)
|
---|
30 | . S SDWLSTAT=$P(SDWLX,U,17)
|
---|
31 | . S SDWLORDT=$P(SDWLX,U,2)
|
---|
32 | . S SDWLDTQ=0 I $D(SDWLDATB) D
|
---|
33 | . . I SDWLORDT<SDWLDATB S SDWLDTQ=1 Q
|
---|
34 | . . I SDWLORDT>SDWLDATE S SDWLDTQ=1 Q
|
---|
35 | . I SDWLDTQ Q
|
---|
36 | . S SDWLFLG="O" I SDWLOPEN[SDWLSTAT,SDWLSTAT="C" D
|
---|
37 | . . S SDWLFLG="C-ND" I $G(^SDWL(409.3,SDWLDA,"DIS")) S SDWLFLG="C",SDWLORDT=$P(^SDWL(409.3,SDWLDA,"DIS"),U)
|
---|
38 | . S SDWLFLG=$S(SDWLFLG="O":1,SDWLFLG="C":2,1:3)
|
---|
39 | . S X1=SDWLDT,X2=SDWLORDT D ^%DTC S SDWLAPD=X
|
---|
40 | . I SDWLAPD<30 S SDWLFL=1
|
---|
41 | . I SDWLAPD>29&(SDWLAPD<120) S SDWLFL=2
|
---|
42 | . I SDWLAPD>120 S SDWLFL=3
|
---|
43 | . S SDWLCNT=0 I $D(^TMP("SDWLR31",$J,SDWLIN,SDWLFLG,SDWLFL,SDWLTY,SDWLTYP)) S SDWLCNT=^(SDWLTYP)
|
---|
44 | . S SDWLCNT=SDWLCNT+1 S ^TMP("SDWLR31",$J,SDWLIN,SDWLFLG,SDWLFL,SDWLTY,SDWLTYP)=SDWLCNT
|
---|
45 | . ;S ^TMP("SDWLR31",$J,"B",SDWLDA,SDWLFL,SDWLTY,SDWLTYP,SDWLFLG)=""
|
---|
46 | Q
|
---|
47 | PRINT ;PRINT REPORT
|
---|
48 | D HD
|
---|
49 | S (SDWLIN,SDWLTY,SDWLTYP,SDWLFL)=0,(S1,S2,S3)=0
|
---|
50 | B0 F S SDWLIN=$O(^TMP("SDWLR31",$J,SDWLIN)) Q:SDWLIN<1 D
|
---|
51 | .S (S1,S2,S3,S1T,S2T,S3T)=0
|
---|
52 | .S SDWLINX=$$GET1^DIQ(4,SDWLIN_",",.01) W !,$E(SDWLINX,1,20)," (",SDWLIN,")"
|
---|
53 | .S SDWLFLG=0
|
---|
54 | .F S SDWLFLG=$O(^TMP("SDWLR31",$J,SDWLIN,SDWLFLG)) Q:SDWLFLG<1 D D S2
|
---|
55 | ..W ?22,$S(SDWLFLG=1:"(OPEN RECORDS)",SDWLFLG=2:"(CLOSED RECORDS)",SDWLFLG=3:"(CLOSED - WITH NO DISPOSITION RECORDED)",1:"UNKNOWN"),!!
|
---|
56 | ..S SDWLFL=0
|
---|
57 | ..F S SDWLFL=$O(^TMP("SDWLR31",$J,SDWLIN,SDWLFLG,SDWLFL)) Q:SDWLFL<1 D
|
---|
58 | ...S SDWLTY=0
|
---|
59 | ...F S SDWLTY=$O(^TMP("SDWLR31",$J,SDWLIN,SDWLFLG,SDWLFL,SDWLTY)) Q:SDWLTY<1 D D S1
|
---|
60 | ....S SDWLTYX=$$EXTERNAL^DILFD(409.3,4,,SDWLTY) W ?22,$E(SDWLTYX,1,15)
|
---|
61 | ....S SDWLTYP=0
|
---|
62 | ....F S SDWLTYP=$O(^TMP("SDWLR31",$J,SDWLIN,SDWLFLG,SDWLFL,SDWLTY,SDWLTYP)) Q:SDWLTYP<1 D
|
---|
63 | .....S SDWLF=$S(SDWLTY=1:404.51,SDWLTY=2:404.57,SDWLTY=3:409.31,SDWLTY=4:409.32,1:0) I 'SDWLF S SDWLTYN=""
|
---|
64 | .....S SDWLTYN=$$GET1^DIQ(SDWLF,SDWLTYP_",",.01) W ?40,$E(SDWLTYN,1,12)
|
---|
65 | .....S SDWLN=$G(^TMP("SDWLR31",$J,SDWLIN,SDWLFLG,SDWLFL,SDWLTY,SDWLTYP)) S @("S"_SDWLFL)=@("S"_SDWLFL)+SDWLN
|
---|
66 | .....S @("S"_SDWLFL_"T")=@("S"_SDWLFL_"T")+SDWLN
|
---|
67 | .....S TAB=$S(SDWLFL=1:55,SDWLFL=2:60,SDWLFL=3:65,1:65) D
|
---|
68 | ......F SDX=1:1:3 D
|
---|
69 | .......S TAB=$S(SDX=1:55,SDX=2:60,SDX=3:65,1:65) D
|
---|
70 | ........W ?TAB I SDX=SDWLFL W $J(SDWLN,$S(SDWLFL<3:3,1:4))
|
---|
71 | ........E W ?TAB,$J(0,$S(SDX<3:3,1:4))
|
---|
72 | ......W !
|
---|
73 | Q
|
---|
74 | S1 W !,?55,"===",?60,"===",?65,"====",!,?40,"SUBTOTALS"
|
---|
75 | W ?55,$J(S1,3),?60,$J(S2,3),?65,$J(S3,4) S (S1,S2,S3)=0 W !!
|
---|
76 | Q
|
---|
77 | S2 W !,?55,"===",?60,"===",?65,"====",!,?43,"TOTALS"
|
---|
78 | W ?55,$J(S1T,3),?60,$J(S2T,3),?65,$J(S3T,4),!!
|
---|
79 | Q
|
---|
80 | HD ;HEADER
|
---|
81 | W:$D(IOF) @IOF W !!,?80-$L("EWL 30/60/120 DAY REPORT")\2,"EWL 30/60/120 DAY REPORT",!!
|
---|
82 | W !,?5,"INSTITUTION",?25,"TYPE",?40,"LOCATION",?55,"<30",?60,">30",?65,">120"
|
---|
83 | W !,?5,"===========",?25,"====",?40,"========",?55,"===",?60,"===",?65,"====",!
|
---|
84 | Q
|
---|