source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDWLROI.m@ 658

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

initial load of FOIAVistA 6/30/08 version
File size: 6.0 KB
Line 
1SDWLROI ;;IOFO BAY PINES/TEH/WAIT LIST STAT REPORT - ENROLLEE ; 01 Oct 2002 4:42 PM ; Compiled December 21, 2006 15:21:55
2 ;;5.3;scheduling;**263,412,415,446**;AUG 13 1993;Build 77
3 ;
4 ; Removed Sort logic as routine exceeded SACC maximum size of 10000
5 ; New routine SDWLROIS was created to perform the Sort functionality
6 ;
7 ;
8EN ;
9 N ZCODE,ZTDESC,ZTDTH,ZTIO,ZTQUEDED,ZTREQ,ZTRTN,ZTSK
10 D INIT G END:$D(DUOUT)
11 D SORT^SDWLROIS(SDWLBD,SDWLED,SDWLINS,.SDWL) ; SD*5.3*412 new routine to perform sort
12 I $$S^ZTLOAD G END
13 D PRT
14 G END
15INIT ;
16 I $D(CT) S SDWLCT=CT
17 I $D(DATE) S SDWLDATE=DATE
18 I $D(INS) S SDWLINS=INS
19 I $D(ZTSAVE) D
20 .S SDWLCT=$G(ZTSAVE("CT")),SDWLDATE=$G(ZTSAVE("DATE")),SDWLINS=$G(ZTSAVE("INS"))
21 I SDWLINS'="ALL" F I=1:1 S SDWL=$P(SDWLINS,";",I) Q:SDWL="" S SDWL("INS",+SDWL)=""
22 S SDWLBD=$P(SDWLDATE,U,1),SDWLED=$P(SDWLDATE,U,2),SDWLPG=0
23 D NOW^%DTC S Y=% D DD^%DT S SDWLDTP=$P(Y,":",1,2)
24 K ZTSAVE
25 N POP S POP=0 ;SD*5.3*412
26 Q
27 ;
28PRT ;PRINT REPORT SD*5.3*412 Q:POP added where needed to allow early exit
29 G END:$$S^ZTLOAD
30 S (T1,T2,T3,T4,T5,T6,T7,T8,T9,T10,T11,T12,T13)=0 ;SD*5.3*446
31 S (TT1,TT2,TT3,TT4,TT5,TT6,TT7,TT8,TT9,TT10,TT11,TT12,TT13,SDWLPG)=0 D HD,HD1 ;SD*5.3*446
32 I '$D(^TMP("SDWLROI1",$J)) W !!,"No Wait List Data to Report" Q
33 S SDWLINS="" F S SDWLINS=$O(^TMP("SDWLROI1",$J,SDWLINS)) Q:SDWLINS="" D Q:POP D T2 Q:POP W !,"________________" I $Y>(IOSL-8) D:$D(SDWLIOSR) SCR Q:POP D HD,HD1 ;SD*5.3*412 added Quit for early exit; 446
34 .W !!,"INSTITUTION: ",SDWLINS
35 .S W1="" F S W1=$O(^TMP("SDWLROI1",$J,SDWLINS,W1)) Q:W1="" D Q:POP D T1 Q:POP I $Y>(IOSL-8) D:$D(SDWLIOSR) SCR Q:POP D HD,HD1 ; SD*5.3*446
36 ..W !,"ENROLLMENT PRIORITY: ",$S(W1="P":"PRIOR",W1="N":"NEW",W1="E":"ESTABLISHED",1:"UNDETERMINED")
37 ..S SDWLTY="" F S SDWLTY=$O(^TMP("SDWLROI1",$J,SDWLINS,W1,SDWLTY)) Q:SDWLTY="" D Q:POP
38 ...S SDWLTNM=$$EXTERNAL^DILFD(409.3,4,,SDWLTY) W !,$E(SDWLTNM,1,15) I $Y>(IOSL-8) D:$D(SDWLIOSR) SCR Q:POP D HD,HD1 ; SD*5.3*446
39 ...S SDWLSCN="" F S SDWLSCN=$O(^TMP("SDWLROI1",$J,SDWLINS,W1,SDWLTY,SDWLSCN)) Q:SDWLSCN="" D Q:POP
40 ....S SDWLSCNM="" F S SDWLSCNM=$O(^TMP("SDWLROI1",$J,SDWLINS,W1,SDWLTY,SDWLSCN,SDWLSCNM)) Q:SDWLSCNM="" D Q:POP
41 .....S SDWLPRI="" F S SDWLPRI=$O(^TMP("SDWLROI1",$J,SDWLINS,W1,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI)) Q:SDWLPRI="" D Q:POP
42 ......N SDWLCLO ;SD*5.3*446
43 ......W !,?2,$E(SDWLSCNM,1,10)," ",$S(SDWLPRI="A":"ASAP",SDWLPRI="F":"FUTURE",1:"")
44 ......S SDWLPR=+$G(^TMP("SDWLROI1",$J,SDWLINS,W1,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"PR")) W ?20,SDWLPR
45 ......S SDWLCLO=+$G(^TMP("SDWLROI1",$J,SDWLINS,W1,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"CL")) W ?27,SDWLCLO ;SD*5.3*415,446
46 ......S SDWLD=+$G(^TMP("SDWLROI1",$J,SDWLINS,W1,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLD")) W ?34,SDWLD ;SD*5.3*415,446
47 ......S SDWLNC=+$G(^TMP("SDWLROI1",$J,SDWLINS,W1,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLNC")) W ?41,SDWLNC ;SD*5.3*446
48 ......S SDWLSA=+$G(^TMP("SDWLROI1",$J,SDWLINS,W1,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLSA")) W ?48,SDWLSA ;SD*5.3*446
49 ......S SDWLCC=+$G(^TMP("SDWLROI1",$J,SDWLINS,W1,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLCC")) W ?55,SDWLCC ;SD*5.3*446
50 ......S SDWLNN=+$G(^TMP("SDWLROI1",$J,SDWLINS,W1,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLNN")) W ?62,SDWLNN ;SD*5.3*446
51 ......S SDWLER=+$G(^TMP("SDWLROI1",$J,SDWLINS,W1,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLER")) W ?69,SDWLER ;SD*5.3*446
52 ......S SDWLCL=+$G(^TMP("SDWLROI1",$J,SDWLINS,W1,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLCL")) W ?76,SDWLCL ;SD*5.3*446
53 ......S SDWLTR=+$G(^TMP("SDWLROI1",$J,SDWLINS,W1,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLTR")) W ?83,SDWLTR ;SD*5.3*446
54 ......S SDWLAD=+$G(^TMP("SDWLROI1",$J,SDWLINS,W1,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"AD")) W ?90,SDWLAD ;SD*5.3*415,446
55 ......S SDWLRR=+$G(^TMP("SDWLROI1",$J,SDWLINS,W1,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"RR")) W ?97,SDWLRR ;SD*5.3*415,446
56 ......S SDWLNR=+$G(^TMP("SDWLROI1",$J,SDWLINS,W1,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"NR")) W ?104,SDWLNR ; SD*5.3*446
57 ......S T1=T1+SDWLPR,TT1=TT1+SDWLPR
58 ......S T2=T2+SDWLCLO,TT2=TT2+SDWLCLO
59 ......S T3=T3+SDWLD,TT3=TT3+SDWLD
60 ......S T4=T4+SDWLNC,TT4=TT4+SDWLNC
61 ......S T5=T5+SDWLSA,TT4=TT4+SDWLSA
62 ......S T6=T6+SDWLCC,TT6=TT6+SDWLCC
63 ......S T7=T7+SDWLNN,TT7=TT7+SDWLNN
64 ......S T8=T8+SDWLER,TT8=TT8+SDWLER
65 ......S T9=T9+SDWLCL,TT9=TT9+SDWLCL ;SD*5.3*446
66 ......S T10=T10+SDWLTR,TT10=TT10+SDWLTR ;SD*5.3*446
67 ......S T11=T11+SDWLAD,TT11=TT11+SDWLAD ;SD*5.3*446
68 ......S T12=T12+SDWLRR,TT12=TT12+SDWLRR ;SD*5.3*446
69 ......S T13=T13+SDWLNR,TT13=TT13+SDWLNR ;SD*5.3*446
70 ......I $Y>(IOSL-8) D:$D(SDWLIOSR) SCR Q:POP D HD,HD1 ;SD*5.3*446
71 Q
72T1 ;
73 ;write sub-totals
74 W !?20,"------ ------ ------ ------ ------ ------ ------ ------ ------ ------ ------ ------ ------" ;SD*5.3*446
75 W !,"Sub-Totals:",?20,T1,?27,T2,?34,T3,?41,T4,?48,T5,?55,T6,?62,T7,?69,T8,?76,T9,?83,T10,?90,T11,?97,T12,?104,T13 ;SD*5.3*446
76 S (T1,T2,T3,T4,T5,T6,T7,T8,T9,T10,T11,T12,T13)=0 ;SD*5.3*446
77 I $Y>(IOSL-8) D:$D(SDWLIOSR) SCR Q:POP D HD,HD1 ;SD*5.3*446
78 Q
79T2 W !,"Institution Totals:"
80 W ?20,TT1,?27,TT2,?34,TT3,?41,TT4,?48,TT5,?55,TT6,?62,TT7,?69,TT8,?76,TT9,?83,TT10,?90,TT11,?97,TT12,?104,TT13,! ;SD*5.3*446
81 S (TT1,TT2,TT3,TT4,TT5,TT6,TT7,TT8,TT9,TT10,TT11,TT12,TT13)=0 ;SD*5.3*415,446
82 I $Y>(IOSL-8) D:$D(SDWLIOSR) SCR Q:POP D HD,HD1 ;SD*5.3*446
83 Q
84HD W:$D(IOF) @IOF S SDWLPG=SDWLPG+1 W !!,SDWLDTP,?80-$L("Wait List (Sch/PCMM) Enroll Status Report")\2,"Wait List (Sch/PCMM) Enroll Status Report",?65,"Page: ",SDWLPG
85 W !,?80-$L("STARTED Date: ")\2,"STARTED Date: " S Y=$P(SDWLDATE,U,1) D DD^%DT W Y
86 W !,?80-$L("FINISHED Date: ")\2,"FINISHED Date: " S Y=$P(SDWLDATE,U,2) D DD^%DT W Y
87 Q
88HD1 ;
89 W !,?20,"PREV",?90,"#",?97,"#",?104,"# NOT" ;SD*5.3*415,446
90 W !,"WAIT LIST TYPE",?20,"REMN",?27,"CLSD",?34,"DTH",?41,"NC",?48,"SA",?55,"CC",?62,"NN",?69,"ER",?76,"CL",?83,"TR",?90,"ADD",?97,"REMN",?104,"REMVD" ;SD*5.3*446
91 Q
92SCR S DIR(0)="E" D ^DIR S:X="^" POP=1
93 Q
94END D EN^SDWLKIL
95 K ^TMP("SDWLROI1",$J),^TMP("SDWLROI2",$J),CT,DATE,I,INS
96 K T1,T2,T3,T4,T5,T6,T7,T8,T9,T10,T11,T12,T13,X1,X2,X3,X0,Y1,W1,X4,X1,X2 ;SD*5.3*446
97 K TT1,TT2,TT3,TT4,TT5,TT6,TT7,TT8,TT9,TT10,TT11,TT12,TT13,SDWLXEN,SDWLRDT,SDWLIOSR ;SD*5.3*446
98 Q
Note: See TracBrowser for help on using the repository browser.