source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDWLR31.m@ 738

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

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1SDWLR31 ;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
9EN ;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
19SORT 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))
21A0 I '$D(SDWLINS) Q
22A1 I '$D(SDWLDATE) Q
23A2 I '$D(SDWLOPEN) Q
24 I SDWLDATE'="ALL" S SDWLDATB=$P(SDWLDATE,U),SDWLDATE=$P(SDWLDATE,U,2)
25A3 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
47PRINT ;PRINT REPORT
48 D HD
49 S (SDWLIN,SDWLTY,SDWLTYP,SDWLFL)=0,(S1,S2,S3)=0
50B0 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
74S1 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
77S2 W !,?55,"===",?60,"===",?65,"====",!,?43,"TOTALS"
78 W ?55,$J(S1T,3),?60,$J(S2T,3),?65,$J(S3T,4),!!
79 Q
80HD ;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
Note: See TracBrowser for help on using the repository browser.