Changeset 636 for FOIAVistA/tag/r/SCHEDULING-SD-SC/SDWLRSR.m
- Timestamp:
- Dec 4, 2009, 8:26:01 PM (14 years ago)
- Location:
- FOIAVistA/tag/r
- Files:
-
- 1 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
FOIAVistA/tag/r/SCHEDULING-SD-SC/SDWLRSR.m
r628 r636 1 SDWLRSR ; BPOI/TEH - WAIT LIST STAT REPORT;10/01/022 ;;5.3;scheduling;**263,273,399,412,425,415, 524**;08/13/93;Build 291 SDWLRSR ;;IOFO BAY PINES/TEH/WAIT LIST STAT REPORT ; 01 Oct 2002 4:42 PM ; Compiled December 21, 2006 15:32:50 2 ;;5.3;scheduling;**263,273,399,412,425,415,446**;AUG 13 1993;Build 77 3 3 ; 4 4 ; Removed Sort logic as routine exceeded SACC maximum size of 10000 … … 15 15 I $D(DATE) S SDWLDATE=DATE 16 16 I $D(INS) S SDWLINS=INS 17 I $D(EXCL) S SDWLEXCL=EXCL18 17 I $D(ZTSAVE) D 19 .S SDWLCT=$G(ZTSAVE("CT")),SDWLDATE=$G(ZTSAVE("DATE")),SDWLINS=$G(ZTSAVE("INS")) ,SDWLEXCL=$G(ZTSAVE("EXCL"))18 .S SDWLCT=$G(ZTSAVE("CT")),SDWLDATE=$G(ZTSAVE("DATE")),SDWLINS=$G(ZTSAVE("INS")) 20 19 I SDWLINS'="ALL" F I=1:1 S SDWL=$P(SDWLINS,";",I) Q:SDWL="" S SDWL("INS",+SDWL)="" 21 20 S SDWLBD=$P(SDWLDATE,U,1),SDWLED=$P(SDWLDATE,U,2),SDWLPG=0 … … 24 23 Q 25 24 PRT ;PRINT REPORT 26 S (TT1,TT2,TT3,TT4,TT5,TT6,TT7,TT8,TT9,TT10,TT11,TT12,SDWLPG)=0 D HD,HD1 ;SD*5.3*415 25 S (T1,T2,T3,T4,T5,T6,T7,T8,T9,T10,T11,T12,T13)=0 ;SD*5.3*446 26 S (TT1,TT2,TT3,TT4,TT5,TT6,TT7,TT8,TT9,TT10,TT11,TT12,TT13,SDWLPG)=0 D HD,HD1 ;SD*5.3*415,446 27 27 I '$D(^TMP("SDWLRSR1")) W !!,"No Wait List Data to Report" Q 28 S SDWLINS="" F S SDWLINS=$O(^TMP("SDWLRSR1",$J,SDWLINS)) Q:SDWLINS="" D Q:POP D T2 Q:POP W !,"________________" I $Y>(IOSL- 5) D:$D(SDWLSPT) SCR Q:POP D HD,HD1 ;SD*5.3*412 added Quit for early exit29 .I $$S^%ZTLOAD S DUOUT="" Q 30 .W !!,"INSTITUTION: ",SDWLINS,! K ^XTMP("SDWLRSR")28 S SDWLINS="" F S SDWLINS=$O(^TMP("SDWLRSR1",$J,SDWLINS)) Q:SDWLINS="" D Q:POP D T2 Q:POP W !,"________________" I $Y>(IOSL-8) D:$D(SDWLSPT) SCR Q:POP D HD,HD1 ;SD*5.3*412 added Quit for early exit; 446 29 .I $$S^%ZTLOAD S DUOUT="" Q 30 .W !!,"INSTITUTION: ",SDWLINS,! 31 31 .S SDWLTY="" F S SDWLTY=$O(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY)) Q:SDWLTY="" D Q:POP ;SD*5.3*412 added Quit for early exit 32 ..S SDWLTNM=$$EXTERNAL^DILFD(409.3,4,,SDWLTY) 32 ..S SDWLTNM=$$EXTERNAL^DILFD(409.3,4,,SDWLTY) W !,$E(SDWLTNM,1,15) 33 33 ..S SDWLSCN="" F S SDWLSCN=$O(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN)) Q:SDWLSCN="" D Q:POP ;SD*5.3*412 added Quit for early exit 34 ...S (T1,T2,T3,T4,T5,T6,T7,T8,T9,T10,T11,T12)=0 ;SD*5.3*41535 34 ...S SDWLSCNM="" F S SDWLSCNM=$O(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM)) Q:SDWLSCNM="" D Q:POP D T1 Q:POP ;SD*5.3*412 added Quit 36 35 ....S SDWLPRI="" F S SDWLPRI=$O(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI)) Q:SDWLPRI="" D Q:POP ;SD*5.3*412 added Quit 37 .....S SDWLFLG=0 38 .....S SDWLPR=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"PR")) I SDWLEXCL,SDWLPR S SDWLFLG=1 39 .....S SDWLCL=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"CL")) I 'SDWLFLG,SDWLEXCL,SDWLCL S SDWLFLG=1 40 .....S SDWLD=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLD")) I 'SDWLFLG,SDWLEXCL,SDWLD S SDWLFLG=1 ;SD*5.3*415 41 .....S SDWLNC=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLNC")) I 'SDWLFLG,SDWLEXCL,SDWLNC S SDWLFLG=1 ;SD*5.3*415 42 .....S SDWLSA=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLSA")) I 'SDWLFLG,SDWLEXCL,SDWLSA S SDWLFLG=1 ;SD*5.3*415 43 .....S SDWLCC=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLCC")) I 'SDWLFLG,SDWLEXCL,SDWLCC S SDWLFLG=1 ;SD*5.3*415 44 .....S SDWLNN=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLNN")) I 'SDWLFLG,SDWLEXCL,SDWLNN S SDWLFLG=1 ;SD*5.3*415 45 .....S SDWLER=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLER")) I 'SDWLFLG,SDWLEXCL,SDWLER S SDWLFLG=1 ;SD*5.3*415 46 .....S SDWLTR=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLTR")) I 'SDWLFLG,SDWLEXCL,SDWLTR S SDWLFLG=1 ;SD*5.3*415 47 .....S SDWLAD=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"AD")) I 'SDWLFLG,SDWLEXCL,SDWLAD S SDWLFLG=1 ;SD*5.3*415 48 .....S SDWLRR=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"RR")) I 'SDWLFLG,SDWLEXCL,SDWLRR S SDWLFLG=1 ;SD*5.3*415 49 .....S SDWLNR=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"NR")) I 'SDWLFLG,SDWLEXCL,SDWLNR S SDWLFLG=1 ;W ?72,$J(SDWLNR,3) 50 .....I 'SDWLEXCL,'SDWLFLG S SDWLFG=1 51 .....I SDWLEXCL,'SDWLFLG Q 52 .....I '$D(^XTMP("SDWLRSR",$J,SDWLTNM)) W !,$E(SDWLTNM,1,15) S ^XTMP("SDWLRSR",$J,SDWLTNM)="" 53 .....W !?2,$E(SDWLSCNM_" "_$S(SDWLPRI="A":"ASAP",SDWLPRI="F":"FUTURE",1:""),1,17) 54 .....S T1=T1+SDWLPR,TT1=TT1+SDWLPR W ?21,$J(SDWLPR,3) 55 .....S T2=T2+SDWLCL,TT2=TT2+SDWLCL W ?26,$J(SDWLCL,3) 56 .....S T3=T3+SDWLD,TT3=TT3+SDWLD W ?31,$J(SDWLD,3) 57 .....S T4=T4+SDWLNC,TT4=TT4+SDWLNC W ?36,$J(SDWLNC,3) 58 .....S T5=T5+SDWLSA,TT5=TT5+SDWLSA W ?41,$J(SDWLSA,3) 59 .....S T6=T6+SDWLCC,TT6=TT6+SDWLCC W ?46,$J(SDWLCC,3) 60 .....S T7=T7+SDWLNN,TT7=TT7+SDWLNN W ?51,$J(SDWLNN,3) 61 .....S T8=T8+SDWLER,TT8=TT8+SDWLER W ?56,$J(SDWLER,3) 62 .....S T9=T9+SDWLTR,TT9=TT9+SDWLTR W ?61,$J(SDWLTR,3) ;SD*5.3*415 63 .....S T10=T10+SDWLAD,TT10=TT10+SDWLAD W ?66,$J(SDWLAD,3) ;SD*5.3*415 64 .....S T11=T11+SDWLRR,TT11=TT11+SDWLRR W ?71,$J(SDWLRR,3) ;SD*5.3*415 65 .....S T12=T12+SDWLNR,TT12=TT12+SDWLNR W ?76,$J(SDWLNR,3) ;SD*5.3*415 66 .....I $Y>(IOSL-5) D:$D(SDWLSPT) SCR Q:POP D HD,HD1 ;SD*5.3*412 36 .....N SDWLCLO ; SD*5.3*446 37 .....W !,?2,$E(SDWLSCNM,1,10)," ",$S(SDWLPRI="A":"ASAP",SDWLPRI="F":"FUTURE",1:"") 38 .....S SDWLPR=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"PR")) W ?20,SDWLPR 39 .....S SDWLCLO=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"CL")) W ?27,SDWLCLO ;SD*5.3*446 40 .....S SDWLD=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLD")) W ?34,SDWLD ;SD*5.3*415,446 41 .....S SDWLNC=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLNC")) W ?41,SDWLNC ;SD*5.3*415,446 42 .....S SDWLSA=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLSA")) W ?48,SDWLSA ;SD*5.3*415,446 43 .....S SDWLCC=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLCC")) W ?55,SDWLCC ;SD*5.3*415,446 44 .....S SDWLNN=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLNN")) W ?62,SDWLNN ;SD*5.3*415,446 45 .....S SDWLER=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLER")) W ?69,SDWLER ;SD*5.3*415,446 46 .....S SDWLCL=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLCL")) W ?76,SDWLCL ;SD*5.3*415,446 47 .....S SDWLTR=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLTR")) W ?83,SDWLTR ;SD*5.3*415,446 48 .....S SDWLAD=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"AD")) W ?90,SDWLAD ;SD*5.3*415,446 49 .....S SDWLRR=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"RR")) W ?97,SDWLRR ;SD*5.3*415,446 50 .....S SDWLNR=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"NR")) W ?104,SDWLNR ;SD*5.3*446 51 .....S T1=T1+SDWLPR,TT1=TT1+SDWLPR 52 .....S T2=T2+SDWLCLO,TT2=TT2+SDWLCLO ;SD*5.3*446 53 .....S T3=T3+SDWLD,TT3=TT3+SDWLD 54 .....S T4=T4+SDWLNC,TT4=TT4+SDWLNC 55 .....S T5=T5+SDWLSA,TT5=TT5+SDWLSA 56 .....S T6=T6+SDWLCC,TT6=TT6+SDWLCC 57 .....S T7=T7+SDWLNN,TT7=TT7+SDWLNN 58 .....S T8=T8+SDWLER,TT8=TT8+SDWLER 59 .....S T9=T9+SDWLCL,TT9=TT9+SDWLCL ;SD*5.3*446 60 .....S T10=T10+SDWLTR,TT10=TT10+SDWLTR ;SD*5.3*446 61 .....S T11=T11+SDWLAD,TT11=TT11+SDWLAD ;SD*5.3*446 62 .....S T12=T12+SDWLRR,TT12=TT12+SDWLRR ;SD*5.3*446 63 .....S T13=T13+SDWLNR,TT13=TT13+SDWLNR ;SD*5.3*446 64 .....I $Y>(IOSL-8) D:$D(SDWLSPT) SCR Q:POP D HD,HD1 ;SD*5.3*412,446 67 65 Q 68 66 SCR S DIR(0)="E" D ^DIR S:X="^" POP=1 ;SD*5.3*412 69 67 Q 70 68 T1 ; 71 I 'SDWLFLG,SDWLEXCL Q72 W !?20,"---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ----" ;SD*5.3*41573 W !,"Sub-Totals:"74 69 ;write sub-totals 75 W ?21,$J(T1,3),?26,$J(T2,3),?31,$J(T3,3),?36,$J(T4,3),?41,$J(T5,3),?46,$J(T6,3),?51,$J(T7,3),?56,$J(T8,3),?61,$J(T9,3),?66,$J(T10,3),?71,$J(T11,3),?76,$J(T12,3),! ;SD*5.3*415 76 S (T1,T2,T3,T4,T5,T6,T7,T8,T9,T10,T11,T12)=0 ;SD*5.3*415 77 I $Y>(IOSL-5) D:$D(SDWLSPT) SCR Q:POP D HD,HD1 ;SD*5.3*412 70 W !?20,"------ ------ ------ ------ ------ ------ ------ ------ ------ ------ ------ ------ ------" ;SD*5.3*446 71 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 72 S (T1,T2,T3,T4,T5,T6,T7,T8,T9,T10,T11,T12,T13)=0 ;SD*5.3*415,446 73 I $Y>(IOSL-8) D:$D(SDWLSPT) SCR Q:POP D HD,HD1 ;SD*5.3*412,446 78 74 Q 79 75 T2 W !,"Institution Totals:" 80 W ?2 1,$J(TT1,3),?26,$J(TT2,3),?31,$J(TT3,3),?36,$J(TT4,3),?41,$J(TT5,3),?46,$J(TT6,3),?51,$J(TT7,3),?56,$J(TT8,3),?61,$J(TT9,3),?66,$J(TT10,3),?71,$J(TT11,3),?76,$J(TT12,3),! ;SD*5.3*41581 S (TT1,TT2,TT3,TT4,TT5,TT6,TT7,TT8,TT9,TT10,TT11,TT12 )=0 ;SD*5.3*41582 I $Y>(IOSL- 5) D:$D(SDWLSPT) SCR Q:POP D HD,HD1 ;SD*5.3*41276 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 77 S (TT1,TT2,TT3,TT4,TT5,TT6,TT7,TT8,TT9,TT10,TT11,TT12,TT13)=0 ;SD*5.3*415,446 78 I $Y>(IOSL-8) D:$D(SDWLSPT) SCR Q:POP D HD,HD1 ;SD*5.3*412,446 83 79 Q 84 80 HD W:$D(IOF) @IOF S SDWLPG=SDWLPG+1 W !!,SDWLDTP,?80-$L("Wait List (Sch/PCMM) Stat Report")\2,"Wait List (Sch/PCMM) Stat Report",?65,"Page: ",SDWLPG … … 87 83 Q 88 84 HD1 ; 89 W !,?20,"PREV" 90 W ?65,"#" 91 W ?75,"# NOT" 92 W !,"WAIT LIST TYPE" 93 W ?20,"REMN",?25,"CLSD",?31,"DTH",?37,"NC",?42,"SA",?47,"CC",?52,"NN",?57,"ER",?61,"TR",?65,"ADD",?70,"REMN",?75,"REMVD",! ;SD*5.3*415 85 W !,?20,"PREV",?90,"#",?97,"#",?104,"# NOT" ;SD*5.3*415,446 86 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 94 87 Q 95 88 END D EN^SDWLKIL 96 89 K ^TMP("SDWLRSR1",$J),^TMP("SDWLRSR2",$J),SDWLY1,SDWLX1,SDWLRDT,CT,I 97 K T1,T2,T3,T4,T5,T6,T7,T8,T9,T10,T11,T12, SDWLAD,SDWLBD,SDWLCC,SDWLCT,SDWLDFDT,SDWLDP,SDWLED,SDWLER,SDWLERR,SDWLFLD,X1,X2,DATE ;SD*5.3*41598 K TT1,TT2,TT3,TT4,TT5,TT6,TT7,TT8,TT9,TT10,TT11,TT12, SDWLINSN,SDWLINST,SDWLNC,SDWLNN,SDWLNR,SDWLOFDT,SDWLOK1,SDWLOK2,SDWLTYPN ;SD*5.3*41599 K SDWLOK3,SDWLPR,SDWLPR,SDWLPROM,SDWLRE,SDWLRFDT,SDWLRR,SDWLSA,SDWLSCN,SDWLSCNM,SDWLTASK,SDWLTK,SDWLTNM,SDWLTYNM,SDWLTYP,X4,SDWLTR ;SD*5.3*41590 K T1,T2,T3,T4,T5,T6,T7,T8,T9,T10,T11,T12,T13,SDWLAD,SDWLBD,SDWLCC,SDWLCT,SDWLDFDT,SDWLDP,SDWLED,SDWLER,SDWLERR,SDWLFLD,X1,X2,DATE ;SD*5.3*415,446 91 K TT1,TT2,TT3,TT4,TT5,TT6,TT7,TT8,TT9,TT10,TT11,TT12,TT13,SDWLINSN,SDWLINST,SDWLNC,SDWLNN,SDWLNR,SDWLOFDT,SDWLOK1,SDWLOK2,SDWLTYPN ;SD*5.3*415,446 92 K SDWLOK3,SDWLPR,SDWLPR,SDWLPROM,SDWLRE,SDWLRFDT,SDWLRR,SDWLSA,SDWLSCN,SDWLSCNM,SDWLTASK,SDWLTK,SDWLTNM,SDWLTYNM,SDWLTYP,X4,SDWLTR,SDWLCL ;SD*5.3*415,446 100 93 Q
Note:
See TracChangeset
for help on using the changeset viewer.