- SDWLRSR ;BPOI/TEH - WAIT LIST STAT REPORT;10/01/02 ; 4/1/08 12:52pm
- ;;5.3;scheduling;**263,273,399,412,425,415,446,524,505**;08/13/93;Build 20
- ;
- ; Removed Sort logic as routine exceeded SACC maximum size of 10000
- ; New routine SDWLRSRS was created to perform the Sort functionality
- ;
- ;
- EN ;
- N DIR,DUOUT,SDWL,SDWLCL,SDWLCT2,SDWLD,SDWLDATE,SDWLDTP
- N SDWLEXCL,SDWLFG,SDWLFLG,SDWLINS,SDWLPG,SDWLPRI,SDWLSPT,SDWLTY
- N X,Y,SDFLG,SDI
- D INIT G END:$D(DUOUT) ;SD*5.3*415
- D SORT^SDWLRSRS(SDWLBD,SDWLED,SDWLINS,.SDWL) ; SD*5.3*415 new routine to perform sort
- D:'$$S^%ZTLOAD PRT ;SD*5.3*415
- G END
- INIT ;
- I $D(CT) S SDWLCT2=CT
- I $D(DATE) S SDWLDATE=DATE
- I $D(INS) S SDWLINS=INS
- I $D(EXCL) S SDWLEXCL=EXCL
- I $D(ZTSAVE) D
- .S SDWLCT=$G(ZTSAVE("CT")),SDWLDATE=$G(ZTSAVE("DATE")),SDWLINS=$G(ZTSAVE("INS")),SDWLEXCL=$G(ZTSAVE("EXCL"))
- I SDWLINS'="ALL" F I=1:1 S SDWL=$P(SDWLINS,";",I) Q:SDWL="" S SDWL("INS",+SDWL)=""
- S SDWLBD=$P(SDWLDATE,U,1),SDWLED=$P(SDWLDATE,U,2),SDWLPG=0
- D NOW^%DTC S Y=% D DD^%DT S SDWLDTP=Y
- N POP S POP=0 ;SD*5.3*412
- Q
- PRT ;PRINT REPORT
- S (GT1,GT2,GT3,GT4,GT5,GT6,GT7,GT8,GT9,GT10,GT11,GT12)=0
- S (TT1,TT2,TT3,TT4,TT5,TT6,TT7,TT8,TT9,TT10,TT11,TT12,SDWLPG)=0 D HD,HD1 ;SD*5.3*415
- I '$D(^TMP("SDWLRSR1")) W !!,"No Wait List Data to Report" Q
- 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 exit
- .I $$S^%ZTLOAD S DUOUT="" Q
- .W !!,"INSTITUTION: ",SDWLINS,! K ^XTMP("SDWLRSR")
- .S ^XTMP("SDWLRSR",0)=DT_U_DT
- .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
- ..S SDWLTNM=$$EXTERNAL^DILFD(409.3,4,,SDWLTY)
- ..S SDWLSCN="" F S SDWLSCN=$O(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN)) Q:SDWLSCN="" D Q:POP D T1 ;SD*5.3*412 added Quit for early exit
- ...S (T1,T2,T3,T4,T5,T6,T7,T8,T9,T10,T11,T12)=0 ;SD*5.3*415
- ...S SDWLSCNM="" F S SDWLSCNM=$O(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM)) Q:SDWLSCNM="" D Q:POP ;SD*5.3*412 added Quit
- ....S SDWLPRI="",SDWLFLG=0 F S SDWLPRI=$O(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI)) Q:SDWLPRI="" D Q:POP ;SD*5.3*412 added Quit
- .....S SDWLPR=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"PR")) I SDWLEXCL,SDWLPR S SDWLFLG=1
- .....S SDWLCL=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"CL")) I 'SDWLFLG,SDWLEXCL,SDWLCL S SDWLFLG=1
- .....S SDWLD=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLD")) I 'SDWLFLG,SDWLEXCL,SDWLD S SDWLFLG=1 ;SD*5.3*415
- .....S SDWLNC=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLNC")) I 'SDWLFLG,SDWLEXCL,SDWLNC S SDWLFLG=1 ;SD*5.3*415
- .....S SDWLSA=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLSA")) I 'SDWLFLG,SDWLEXCL,SDWLSA S SDWLFLG=1 ;SD*5.3*415
- .....S SDWLCC=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLCC")) I 'SDWLFLG,SDWLEXCL,SDWLCC S SDWLFLG=1 ;SD*5.3*415
- .....S SDWLNN=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLNN")) I 'SDWLFLG,SDWLEXCL,SDWLNN S SDWLFLG=1 ;SD*5.3*415
- .....S SDWLER=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLER")) I 'SDWLFLG,SDWLEXCL,SDWLER S SDWLFLG=1 ;SD*5.3*415
- .....S SDWLTR=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLTR")) I 'SDWLFLG,SDWLEXCL,SDWLTR S SDWLFLG=1 ;SD*5.3*415
- .....S SDWLAD=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"AD")) I 'SDWLFLG,SDWLEXCL,SDWLAD S SDWLFLG=1 ;SD*5.3*415
- .....S SDWLRR=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"RR")) I 'SDWLFLG,SDWLEXCL,SDWLRR S SDWLFLG=1 ;SD*5.3*415
- .....S SDWLNR=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"NR")) I 'SDWLFLG,SDWLEXCL,SDWLNR S SDWLFLG=1
- .....K SDFLG F SDI="SDWLPR","SDWLCL","SDWLD","SDWLNC","SDWLSA","SDWLCC","SDWLNN","SDWLER","SDWLTR","SDWLAD","SDWLRR","SDWLNR" D
- ......I @SDI S SDFLG=1
- .....I 'SDWLEXCL,'SDWLFLG S SDWLFLG=1
- .....I SDWLEXCL,'SDWLFLG Q
- .....I SDWLEXCL,'$D(SDFLG) Q
- .....I '$D(^XTMP("SDWLRSR",$J,SDWLTNM)) W !,$E(SDWLTNM,1,15) S ^XTMP("SDWLRSR",$J,SDWLTNM)=""
- .....W !?2,$E(SDWLSCNM_" "_$S(SDWLPRI="A":"ASAP",SDWLPRI="F":"FUTURE",1:""),1,17)
- .....S T1=T1+SDWLPR,TT1=TT1+SDWLPR W ?21,$J(SDWLPR,3)
- .....S GT1=GT1+SDWLPR
- .....S T2=T2+SDWLCL,TT2=TT2+SDWLCL W ?26,$J(SDWLCL,3)
- .....S GT2=GT2+SDWLCL
- .....S T3=T3+SDWLD,TT3=TT3+SDWLD W ?31,$J(SDWLD,3)
- .....S GT3=GT3+SDWLD
- .....S T4=T4+SDWLNC,TT4=TT4+SDWLNC W ?36,$J(SDWLNC,3)
- .....S GT4=GT4+SDWLNC
- .....S T5=T5+SDWLSA,TT5=TT5+SDWLSA W ?41,$J(SDWLSA,3)
- .....S GT5=GT5+SDWLSA
- .....S T6=T6+SDWLCC,TT6=TT6+SDWLCC W ?46,$J(SDWLCC,3)
- .....S GT6=GT6+SDWLCC
- .....S T7=T7+SDWLNN,TT7=TT7+SDWLNN W ?51,$J(SDWLNN,3)
- .....S GT7=GT7+SDWLNN
- .....S T8=T8+SDWLER,TT8=TT8+SDWLER W ?56,$J(SDWLER,3)
- .....S GT8=GT8+SDWLER
- .....S T9=T9+SDWLTR,TT9=TT9+SDWLTR W ?61,$J(SDWLTR,3) ;SD*5.3*415
- .....S GT9=GT9+SDWLTR
- .....S T10=T10+SDWLAD,TT10=TT10+SDWLAD W ?66,$J(SDWLAD,3) ;SD*5.3*415
- .....S GT10=GT10+SDWLAD
- .....S T11=T11+SDWLRR,TT11=TT11+SDWLRR W ?71,$J(SDWLRR,3) ;SD*5.3*415
- .....S GT11=GT11+SDWLRR
- .....S T12=T12+SDWLNR,TT12=TT12+SDWLNR W ?76,$J(SDWLNR,3) ;SD*5.3*415
- .....S GT12=GT12+SDWLNR
- .....I $Y>(IOSL-5) D:$D(SDWLSPT) SCR Q:POP D HD,HD1 ;SD*5.3*412
- D GT
- Q
- SCR S DIR(0)="E" D ^DIR S:X="^" POP=1 ;SD*5.3*412
- Q
- T1 ;
- I 'SDWLFLG,SDWLEXCL Q
- W !?20,"---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ----" ;SD*5.3*415
- W !,"Sub-Totals:"
- ;write sub-totals
- 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
- S (T1,T2,T3,T4,T5,T6,T7,T8,T9,T10,T11,T12)=0 ;SD*5.3*415
- I $Y>(IOSL-5) D:$D(SDWLSPT) SCR Q:POP D HD,HD1 ;SD*5.3*412
- Q
- T2 W !,"Institution Totals:"
- W ?21,$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*415
- S (TT1,TT2,TT3,TT4,TT5,TT6,TT7,TT8,TT9,TT10,TT11,TT12)=0 ;SD*5.3*415
- I $Y>(IOSL-5) D:$D(SDWLSPT) SCR Q:POP D HD,HD1 ;SD*5.3*412
- Q
- GT ;Grand totals
- W !!,"Grand Totals:"
- W ?21,$J(GT1,3),?26,$J(GT2,3),?31,$J(GT3,3),?36,$J(GT4,3),?41,$J(GT5,3),?46,$J(GT6,3),?51,$J(GT7,3),?56,$J(GT8,3),?61,$J(GT9,3),?66,$J(GT10,3),?71,$J(GT11,3),?76,$J(GT12,3),!
- Q
- 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
- W !,?80-$L("STARTED Date: ")\2,"STARTED Date: " S Y=$P(SDWLDATE,U,1) D DD^%DT W Y
- W !,?80-$L("FINISHED Date: ")\2,"FINISHED Date: " S Y=$P(SDWLDATE,U,2) D DD^%DT W Y
- Q
- HD1 ;
- W !,?20,"PREV"
- W ?65,"#"
- W ?75,"# NOT"
- W !,"WAIT LIST TYPE"
- 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
- Q
- END D EN^SDWLKIL
- K ^TMP("SDWLRSR1",$J),^TMP("SDWLRSR2",$J),SDWLY1,SDWLX1,SDWLRDT,CT,I
- 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*415
- 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*415
- K SDWLOK3,SDWLPR,SDWLPR,SDWLPROM,SDWLRE,SDWLRFDT,SDWLRR,SDWLSA,SDWLSCN,SDWLSCNM,SDWLTASK,SDWLTK,SDWLTNM,SDWLTYNM,SDWLTYP,X4,SDWLTR ;SD*5.3*415
- K GT1,GT2,GT3,GT4,GT5,GT6,GT7,GT8,GT9,GT10,GT11,GT12 ;SD*5.3*505
- K ZTSAVE,^XTMP("SDWLRSR"),INS,EXCL
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDWLRSR 7728 printed Feb 19, 2025@00:29:52 Page 2
- SDWLRSR ;BPOI/TEH - WAIT LIST STAT REPORT;10/01/02 ; 4/1/08 12:52pm
- +1 ;;5.3;scheduling;**263,273,399,412,425,415,446,524,505**;08/13/93;Build 20
- +2 ;
- +3 ; Removed Sort logic as routine exceeded SACC maximum size of 10000
- +4 ; New routine SDWLRSRS was created to perform the Sort functionality
- +5 ;
- +6 ;
- EN ;
- +1 NEW DIR,DUOUT,SDWL,SDWLCL,SDWLCT2,SDWLD,SDWLDATE,SDWLDTP
- +2 NEW SDWLEXCL,SDWLFG,SDWLFLG,SDWLINS,SDWLPG,SDWLPRI,SDWLSPT,SDWLTY
- +3 NEW X,Y,SDFLG,SDI
- +4 ;SD*5.3*415
- DO INIT
- if $DATA(DUOUT)
- GOTO END
- +5 ; SD*5.3*415 new routine to perform sort
- DO SORT^SDWLRSRS(SDWLBD,SDWLED,SDWLINS,.SDWL)
- +6 ;SD*5.3*415
- if '$$S^%ZTLOAD
- DO PRT
- +7 GOTO END
- INIT ;
- +1 IF $DATA(CT)
- SET SDWLCT2=CT
- +2 IF $DATA(DATE)
- SET SDWLDATE=DATE
- +3 IF $DATA(INS)
- SET SDWLINS=INS
- +4 IF $DATA(EXCL)
- SET SDWLEXCL=EXCL
- +5 IF $DATA(ZTSAVE)
- Begin DoDot:1
- +6 SET SDWLCT=$GET(ZTSAVE("CT"))
- SET SDWLDATE=$GET(ZTSAVE("DATE"))
- SET SDWLINS=$GET(ZTSAVE("INS"))
- SET SDWLEXCL=$GET(ZTSAVE("EXCL"))
- End DoDot:1
- +7 IF SDWLINS'="ALL"
- FOR I=1:1
- SET SDWL=$PIECE(SDWLINS,";",I)
- if SDWL=""
- QUIT
- SET SDWL("INS",+SDWL)=""
- +8 SET SDWLBD=$PIECE(SDWLDATE,U,1)
- SET SDWLED=$PIECE(SDWLDATE,U,2)
- SET SDWLPG=0
- +9 DO NOW^%DTC
- SET Y=%
- DO DD^%DT
- SET SDWLDTP=Y
- +10 ;SD*5.3*412
- NEW POP
- SET POP=0
- +11 QUIT
- PRT ;PRINT REPORT
- +1 SET (GT1,GT2,GT3,GT4,GT5,GT6,GT7,GT8,GT9,GT10,GT11,GT12)=0
- +2 ;SD*5.3*415
- SET (TT1,TT2,TT3,TT4,TT5,TT6,TT7,TT8,TT9,TT10,TT11,TT12,SDWLPG)=0
- DO HD
- DO HD1
- +3 IF '$DATA(^TMP("SDWLRSR1"))
- WRITE !!,"No Wait List Data to Report"
- QUIT
- +4 ;SD*5.3*412 added Quit for early exit
- SET SDWLINS=""
- FOR
- SET SDWLINS=$ORDER(^TMP("SDWLRSR1",$JOB,SDWLINS))
- if SDWLINS=""
- QUIT
- Begin DoDot:1
- +5 IF $$S^%ZTLOAD
- SET DUOUT=""
- QUIT
- +6 WRITE !!,"INSTITUTION: ",SDWLINS,!
- KILL ^XTMP("SDWLRSR")
- +7 SET ^XTMP("SDWLRSR",0)=DT_U_DT
- +8 ;SD*5.3*412 added Quit for early exit
- SET SDWLTY=""
- FOR
- SET SDWLTY=$ORDER(^TMP("SDWLRSR1",$JOB,SDWLINS,SDWLTY))
- if SDWLTY=""
- QUIT
- Begin DoDot:2
- +9 SET SDWLTNM=$$EXTERNAL^DILFD(409.3,4,,SDWLTY)
- +10 ;SD*5.3*412 added Quit for early exit
- SET SDWLSCN=""
- FOR
- SET SDWLSCN=$ORDER(^TMP("SDWLRSR1",$JOB,SDWLINS,SDWLTY,SDWLSCN))
- if SDWLSCN=""
- QUIT
- Begin DoDot:3
- +11 ;SD*5.3*415
- SET (T1,T2,T3,T4,T5,T6,T7,T8,T9,T10,T11,T12)=0
- +12 ;SD*5.3*412 added Quit
- SET SDWLSCNM=""
- FOR
- SET SDWLSCNM=$ORDER(^TMP("SDWLRSR1",$JOB,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM))
- if SDWLSCNM=""
- QUIT
- Begin DoDot:4
- +13 ;SD*5.3*412 added Quit
- SET SDWLPRI=""
- SET SDWLFLG=0
- FOR
- SET SDWLPRI=$ORDER(^TMP("SDWLRSR1",$JOB,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI))
- if SDWLPRI=""
- QUIT
- Begin DoDot:5
- +14 SET SDWLPR=+$GET(^TMP("SDWLRSR1",$JOB,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"PR"))
- IF SDWLEXCL
- IF SDWLPR
- SET SDWLFLG=1
- +15 SET SDWLCL=+$GET(^TMP("SDWLRSR1",$JOB,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"CL"))
- IF 'SDWLFLG
- IF SDWLEXCL
- IF SDWLCL
- SET SDWLFLG=1
- +16 ;SD*5.3*415
- SET SDWLD=+$GET(^TMP("SDWLRSR1",$JOB,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLD"))
- IF 'SDWLFLG
- IF SDWLEXCL
- IF SDWLD
- SET SDWLFLG=1
- +17 ;SD*5.3*415
- SET SDWLNC=+$GET(^TMP("SDWLRSR1",$JOB,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLNC"))
- IF 'SDWLFLG
- IF SDWLEXCL
- IF SDWLNC
- SET SDWLFLG=1
- +18 ;SD*5.3*415
- SET SDWLSA=+$GET(^TMP("SDWLRSR1",$JOB,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLSA"))
- IF 'SDWLFLG
- IF SDWLEXCL
- IF SDWLSA
- SET SDWLFLG=1
- +19 ;SD*5.3*415
- SET SDWLCC=+$GET(^TMP("SDWLRSR1",$JOB,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLCC"))
- IF 'SDWLFLG
- IF SDWLEXCL
- IF SDWLCC
- SET SDWLFLG=1
- +20 ;SD*5.3*415
- SET SDWLNN=+$GET(^TMP("SDWLRSR1",$JOB,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLNN"))
- IF 'SDWLFLG
- IF SDWLEXCL
- IF SDWLNN
- SET SDWLFLG=1
- +21 ;SD*5.3*415
- SET SDWLER=+$GET(^TMP("SDWLRSR1",$JOB,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLER"))
- IF 'SDWLFLG
- IF SDWLEXCL
- IF SDWLER
- SET SDWLFLG=1
- +22 ;SD*5.3*415
- SET SDWLTR=+$GET(^TMP("SDWLRSR1",$JOB,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLTR"))
- IF 'SDWLFLG
- IF SDWLEXCL
- IF SDWLTR
- SET SDWLFLG=1
- +23 ;SD*5.3*415
- SET SDWLAD=+$GET(^TMP("SDWLRSR1",$JOB,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"AD"))
- IF 'SDWLFLG
- IF SDWLEXCL
- IF SDWLAD
- SET SDWLFLG=1
- +24 ;SD*5.3*415
- SET SDWLRR=+$GET(^TMP("SDWLRSR1",$JOB,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"RR"))
- IF 'SDWLFLG
- IF SDWLEXCL
- IF SDWLRR
- SET SDWLFLG=1
- +25 SET SDWLNR=+$GET(^TMP("SDWLRSR1",$JOB,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"NR"))
- IF 'SDWLFLG
- IF SDWLEXCL
- IF SDWLNR
- SET SDWLFLG=1
- +26 KILL SDFLG
- FOR SDI="SDWLPR","SDWLCL","SDWLD","SDWLNC","SDWLSA","SDWLCC","SDWLNN","SDWLER","SDWLTR","SDWLAD","SDWLRR","SDWLNR"
- Begin DoDot:6
- +27 IF @SDI
- SET SDFLG=1
- End DoDot:6
- +28 IF 'SDWLEXCL
- IF 'SDWLFLG
- SET SDWLFLG=1
- +29 IF SDWLEXCL
- IF 'SDWLFLG
- QUIT
- +30 IF SDWLEXCL
- IF '$DATA(SDFLG)
- QUIT
- +31 IF '$DATA(^XTMP("SDWLRSR",$JOB,SDWLTNM))
- WRITE !,$EXTRACT(SDWLTNM,1,15)
- SET ^XTMP("SDWLRSR",$JOB,SDWLTNM)=""
- +32 WRITE !?2,$EXTRACT(SDWLSCNM_" "_$SELECT(SDWLPRI="A":"ASAP",SDWLPRI="F":"FUTURE",1:""),1,17)
- +33 SET T1=T1+SDWLPR
- SET TT1=TT1+SDWLPR
- WRITE ?21,$JUSTIFY(SDWLPR,3)
- +34 SET GT1=GT1+SDWLPR
- +35 SET T2=T2+SDWLCL
- SET TT2=TT2+SDWLCL
- WRITE ?26,$JUSTIFY(SDWLCL,3)
- +36 SET GT2=GT2+SDWLCL
- +37 SET T3=T3+SDWLD
- SET TT3=TT3+SDWLD
- WRITE ?31,$JUSTIFY(SDWLD,3)
- +38 SET GT3=GT3+SDWLD
- +39 SET T4=T4+SDWLNC
- SET TT4=TT4+SDWLNC
- WRITE ?36,$JUSTIFY(SDWLNC,3)
- +40 SET GT4=GT4+SDWLNC
- +41 SET T5=T5+SDWLSA
- SET TT5=TT5+SDWLSA
- WRITE ?41,$JUSTIFY(SDWLSA,3)
- +42 SET GT5=GT5+SDWLSA
- +43 SET T6=T6+SDWLCC
- SET TT6=TT6+SDWLCC
- WRITE ?46,$JUSTIFY(SDWLCC,3)
- +44 SET GT6=GT6+SDWLCC
- +45 SET T7=T7+SDWLNN
- SET TT7=TT7+SDWLNN
- WRITE ?51,$JUSTIFY(SDWLNN,3)
- +46 SET GT7=GT7+SDWLNN
- +47 SET T8=T8+SDWLER
- SET TT8=TT8+SDWLER
- WRITE ?56,$JUSTIFY(SDWLER,3)
- +48 SET GT8=GT8+SDWLER
- +49 ;SD*5.3*415
- SET T9=T9+SDWLTR
- SET TT9=TT9+SDWLTR
- WRITE ?61,$JUSTIFY(SDWLTR,3)
- +50 SET GT9=GT9+SDWLTR
- +51 ;SD*5.3*415
- SET T10=T10+SDWLAD
- SET TT10=TT10+SDWLAD
- WRITE ?66,$JUSTIFY(SDWLAD,3)
- +52 SET GT10=GT10+SDWLAD
- +53 ;SD*5.3*415
- SET T11=T11+SDWLRR
- SET TT11=TT11+SDWLRR
- WRITE ?71,$JUSTIFY(SDWLRR,3)
- +54 SET GT11=GT11+SDWLRR
- +55 ;SD*5.3*415
- SET T12=T12+SDWLNR
- SET TT12=TT12+SDWLNR
- WRITE ?76,$JUSTIFY(SDWLNR,3)
- +56 SET GT12=GT12+SDWLNR
- +57 ;SD*5.3*412
- IF $Y>(IOSL-5)
- if $DATA(SDWLSPT)
- DO SCR
- if POP
- QUIT
- DO HD
- DO HD1
- End DoDot:5
- if POP
- QUIT
- End DoDot:4
- if POP
- QUIT
- End DoDot:3
- if POP
- QUIT
- DO T1
- End DoDot:2
- if POP
- QUIT
- End DoDot:1
- if POP
- QUIT
- DO T2
- if POP
- QUIT
- WRITE !,"________________"
- IF $Y>(IOSL-5)
- if $DATA(SDWLSPT)
- DO SCR
- if POP
- QUIT
- DO HD
- DO HD1
- +58 DO GT
- +59 QUIT
- SCR ;SD*5.3*412
- SET DIR(0)="E"
- DO ^DIR
- if X="^"
- SET POP=1
- +1 QUIT
- T1 ;
- +1 IF 'SDWLFLG
- IF SDWLEXCL
- QUIT
- +2 ;SD*5.3*415
- WRITE !?20,"---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ----"
- +3 WRITE !,"Sub-Totals:"
- +4 ;write sub-totals
- +5 ;SD*5.3*415
- WRITE ?21,$JUSTIFY(T1,3),?26,$JUSTIFY(T2,3),?31,$JUSTIFY(T3,3),?36,$JUSTIFY(T4,3),?41,$JUSTIFY(T5,3),?46,$JUSTIFY(T6,3),?51,$JUSTIFY(T7,3),?56,$JUSTIFY(T8,3),?61,$JUSTIFY(T9,3),?66,$JUSTIFY(T10,3),?71,$JUSTIFY(T11,3),?76,$JUSTIFY(T12,3),!
- +6 ;SD*5.3*415
- SET (T1,T2,T3,T4,T5,T6,T7,T8,T9,T10,T11,T12)=0
- +7 ;SD*5.3*412
- IF $Y>(IOSL-5)
- if $DATA(SDWLSPT)
- DO SCR
- if POP
- QUIT
- DO HD
- DO HD1
- +8 QUIT
- T2 WRITE !,"Institution Totals:"
- +1 ;SD*5.3*415
- WRITE ?21,$JUSTIFY(TT1,3),?26,$JUSTIFY(TT2,3),?31,$JUSTIFY(TT3,3),?36,$JUSTIFY(TT4,3),?41,$JUSTIFY(TT5,3),?46,$JUSTIFY(TT6,3),?51,$JUSTIFY(TT7,3),?56,$JUSTIFY(TT8,3),?61,$JUSTIFY(TT9,3),?66,$JUSTIFY(TT10,3),?71,$JUSTIFY(TT11,3),?76,$JUSTIFY(TT1
- 2,3),!
- +2 ;SD*5.3*415
- SET (TT1,TT2,TT3,TT4,TT5,TT6,TT7,TT8,TT9,TT10,TT11,TT12)=0
- +3 ;SD*5.3*412
- IF $Y>(IOSL-5)
- if $DATA(SDWLSPT)
- DO SCR
- if POP
- QUIT
- DO HD
- DO HD1
- +4 QUIT
- GT ;Grand totals
- +1 WRITE !!,"Grand Totals:"
- +2 WRITE ?21,$JUSTIFY(GT1,3),?26,$JUSTIFY(GT2,3),?31,$JUSTIFY(GT3,3),?36,$JUSTIFY(GT4,3),?41,$JUSTIFY(GT5,3),?46,$JUSTIFY(GT6,3),?51,$JUSTIFY(GT7,3),?56,$JUSTIFY(GT8,3),?61,$JUSTIFY(GT9,3),?66,$JUSTIFY(GT10,3),?71,$JUSTIFY(GT11,3),?76,$JUSTIFY(GT1
- 2,3),!
- +3 QUIT
- HD if $DATA(IOF)
- WRITE @IOF
- SET SDWLPG=SDWLPG+1
- WRITE !!,SDWLDTP,?80-$LENGTH("Wait List (Sch/PCMM) Stat Report")\2,"Wait List (Sch/PCMM) Stat Report",?65,"Page: ",SDWLPG
- +1 WRITE !,?80-$LENGTH("STARTED Date: ")\2,"STARTED Date: "
- SET Y=$PIECE(SDWLDATE,U,1)
- DO DD^%DT
- WRITE Y
- +2 WRITE !,?80-$LENGTH("FINISHED Date: ")\2,"FINISHED Date: "
- SET Y=$PIECE(SDWLDATE,U,2)
- DO DD^%DT
- WRITE Y
- +3 QUIT
- HD1 ;
- +1 WRITE !,?20,"PREV"
- +2 WRITE ?65,"#"
- +3 WRITE ?75,"# NOT"
- +4 WRITE !,"WAIT LIST TYPE"
- +5 ;SD*5.3*415
- WRITE ?20,"REMN",?25,"CLSD",?31,"DTH",?37,"NC",?42,"SA",?47,"CC",?52,"NN",?57,"ER",?61,"TR",?65,"ADD",?70,"REMN",?75,"REMVD",!
- +6 QUIT
- END DO EN^SDWLKIL
- +1 KILL ^TMP("SDWLRSR1",$JOB),^TMP("SDWLRSR2",$JOB),SDWLY1,SDWLX1,SDWLRDT,CT,I
- +2 ;SD*5.3*415
- KILL 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
- +3 ;SD*5.3*415
- KILL TT1,TT2,TT3,TT4,TT5,TT6,TT7,TT8,TT9,TT10,TT11,TT12,SDWLINSN,SDWLINST,SDWLNC,SDWLNN,SDWLNR,SDWLOFDT,SDWLOK1,SDWLOK2,SDWLTYPN
- +4 ;SD*5.3*415
- KILL SDWLOK3,SDWLPR,SDWLPR,SDWLPROM,SDWLRE,SDWLRFDT,SDWLRR,SDWLSA,SDWLSCN,SDWLSCNM,SDWLTASK,SDWLTK,SDWLTNM,SDWLTYNM,SDWLTYP,X4,SDWLTR
- +5 ;SD*5.3*505
- KILL GT1,GT2,GT3,GT4,GT5,GT6,GT7,GT8,GT9,GT10,GT11,GT12
- +6 KILL ZTSAVE,^XTMP("SDWLRSR"),INS,EXCL
- +7 QUIT