Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDWLRSR

SDWLRSR.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; Removed Sort logic as routine exceeded SACC maximum size of 10000
  1. ; New routine SDWLRSRS was created to perform the Sort functionality
  1. ;
  1. ;
  1. EN ;
  1. N DIR,DUOUT,SDWL,SDWLCL,SDWLCT2,SDWLD,SDWLDATE,SDWLDTP
  1. N SDWLEXCL,SDWLFG,SDWLFLG,SDWLINS,SDWLPG,SDWLPRI,SDWLSPT,SDWLTY
  1. N X,Y,SDFLG,SDI
  1. D INIT G END:$D(DUOUT) ;SD*5.3*415
  1. D SORT^SDWLRSRS(SDWLBD,SDWLED,SDWLINS,.SDWL) ; SD*5.3*415 new routine to perform sort
  1. D:'$$S^%ZTLOAD PRT ;SD*5.3*415
  1. G END
  1. INIT ;
  1. I $D(CT) S SDWLCT2=CT
  1. I $D(DATE) S SDWLDATE=DATE
  1. I $D(INS) S SDWLINS=INS
  1. I $D(EXCL) S SDWLEXCL=EXCL
  1. I $D(ZTSAVE) D
  1. .S SDWLCT=$G(ZTSAVE("CT")),SDWLDATE=$G(ZTSAVE("DATE")),SDWLINS=$G(ZTSAVE("INS")),SDWLEXCL=$G(ZTSAVE("EXCL"))
  1. I SDWLINS'="ALL" F I=1:1 S SDWL=$P(SDWLINS,";",I) Q:SDWL="" S SDWL("INS",+SDWL)=""
  1. S SDWLBD=$P(SDWLDATE,U,1),SDWLED=$P(SDWLDATE,U,2),SDWLPG=0
  1. D NOW^%DTC S Y=% D DD^%DT S SDWLDTP=Y
  1. N POP S POP=0 ;SD*5.3*412
  1. Q
  1. PRT ;PRINT REPORT
  1. S (GT1,GT2,GT3,GT4,GT5,GT6,GT7,GT8,GT9,GT10,GT11,GT12)=0
  1. S (TT1,TT2,TT3,TT4,TT5,TT6,TT7,TT8,TT9,TT10,TT11,TT12,SDWLPG)=0 D HD,HD1 ;SD*5.3*415
  1. I '$D(^TMP("SDWLRSR1")) W !!,"No Wait List Data to Report" Q
  1. 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
  1. .I $$S^%ZTLOAD S DUOUT="" Q
  1. .W !!,"INSTITUTION: ",SDWLINS,! K ^XTMP("SDWLRSR")
  1. .S ^XTMP("SDWLRSR",0)=DT_U_DT
  1. .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
  1. ..S SDWLTNM=$$EXTERNAL^DILFD(409.3,4,,SDWLTY)
  1. ..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
  1. ...S (T1,T2,T3,T4,T5,T6,T7,T8,T9,T10,T11,T12)=0 ;SD*5.3*415
  1. ...S SDWLSCNM="" F S SDWLSCNM=$O(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM)) Q:SDWLSCNM="" D Q:POP ;SD*5.3*412 added Quit
  1. ....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
  1. .....S SDWLPR=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"PR")) I SDWLEXCL,SDWLPR S SDWLFLG=1
  1. .....S SDWLCL=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"CL")) I 'SDWLFLG,SDWLEXCL,SDWLCL S SDWLFLG=1
  1. .....S SDWLD=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLD")) I 'SDWLFLG,SDWLEXCL,SDWLD S SDWLFLG=1 ;SD*5.3*415
  1. .....S SDWLNC=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLNC")) I 'SDWLFLG,SDWLEXCL,SDWLNC S SDWLFLG=1 ;SD*5.3*415
  1. .....S SDWLSA=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLSA")) I 'SDWLFLG,SDWLEXCL,SDWLSA S SDWLFLG=1 ;SD*5.3*415
  1. .....S SDWLCC=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLCC")) I 'SDWLFLG,SDWLEXCL,SDWLCC S SDWLFLG=1 ;SD*5.3*415
  1. .....S SDWLNN=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLNN")) I 'SDWLFLG,SDWLEXCL,SDWLNN S SDWLFLG=1 ;SD*5.3*415
  1. .....S SDWLER=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLER")) I 'SDWLFLG,SDWLEXCL,SDWLER S SDWLFLG=1 ;SD*5.3*415
  1. .....S SDWLTR=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"SDWLTR")) I 'SDWLFLG,SDWLEXCL,SDWLTR S SDWLFLG=1 ;SD*5.3*415
  1. .....S SDWLAD=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"AD")) I 'SDWLFLG,SDWLEXCL,SDWLAD S SDWLFLG=1 ;SD*5.3*415
  1. .....S SDWLRR=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"RR")) I 'SDWLFLG,SDWLEXCL,SDWLRR S SDWLFLG=1 ;SD*5.3*415
  1. .....S SDWLNR=+$G(^TMP("SDWLRSR1",$J,SDWLINS,SDWLTY,SDWLSCN,SDWLSCNM,SDWLPRI,"NR")) I 'SDWLFLG,SDWLEXCL,SDWLNR S SDWLFLG=1
  1. .....K SDFLG F SDI="SDWLPR","SDWLCL","SDWLD","SDWLNC","SDWLSA","SDWLCC","SDWLNN","SDWLER","SDWLTR","SDWLAD","SDWLRR","SDWLNR" D
  1. ......I @SDI S SDFLG=1
  1. .....I 'SDWLEXCL,'SDWLFLG S SDWLFLG=1
  1. .....I SDWLEXCL,'SDWLFLG Q
  1. .....I SDWLEXCL,'$D(SDFLG) Q
  1. .....I '$D(^XTMP("SDWLRSR",$J,SDWLTNM)) W !,$E(SDWLTNM,1,15) S ^XTMP("SDWLRSR",$J,SDWLTNM)=""
  1. .....W !?2,$E(SDWLSCNM_" "_$S(SDWLPRI="A":"ASAP",SDWLPRI="F":"FUTURE",1:""),1,17)
  1. .....S T1=T1+SDWLPR,TT1=TT1+SDWLPR W ?21,$J(SDWLPR,3)
  1. .....S GT1=GT1+SDWLPR
  1. .....S T2=T2+SDWLCL,TT2=TT2+SDWLCL W ?26,$J(SDWLCL,3)
  1. .....S GT2=GT2+SDWLCL
  1. .....S T3=T3+SDWLD,TT3=TT3+SDWLD W ?31,$J(SDWLD,3)
  1. .....S GT3=GT3+SDWLD
  1. .....S T4=T4+SDWLNC,TT4=TT4+SDWLNC W ?36,$J(SDWLNC,3)
  1. .....S GT4=GT4+SDWLNC
  1. .....S T5=T5+SDWLSA,TT5=TT5+SDWLSA W ?41,$J(SDWLSA,3)
  1. .....S GT5=GT5+SDWLSA
  1. .....S T6=T6+SDWLCC,TT6=TT6+SDWLCC W ?46,$J(SDWLCC,3)
  1. .....S GT6=GT6+SDWLCC
  1. .....S T7=T7+SDWLNN,TT7=TT7+SDWLNN W ?51,$J(SDWLNN,3)
  1. .....S GT7=GT7+SDWLNN
  1. .....S T8=T8+SDWLER,TT8=TT8+SDWLER W ?56,$J(SDWLER,3)
  1. .....S GT8=GT8+SDWLER
  1. .....S T9=T9+SDWLTR,TT9=TT9+SDWLTR W ?61,$J(SDWLTR,3) ;SD*5.3*415
  1. .....S GT9=GT9+SDWLTR
  1. .....S T10=T10+SDWLAD,TT10=TT10+SDWLAD W ?66,$J(SDWLAD,3) ;SD*5.3*415
  1. .....S GT10=GT10+SDWLAD
  1. .....S T11=T11+SDWLRR,TT11=TT11+SDWLRR W ?71,$J(SDWLRR,3) ;SD*5.3*415
  1. .....S GT11=GT11+SDWLRR
  1. .....S T12=T12+SDWLNR,TT12=TT12+SDWLNR W ?76,$J(SDWLNR,3) ;SD*5.3*415
  1. .....S GT12=GT12+SDWLNR
  1. .....I $Y>(IOSL-5) D:$D(SDWLSPT) SCR Q:POP D HD,HD1 ;SD*5.3*412
  1. D GT
  1. Q
  1. SCR S DIR(0)="E" D ^DIR S:X="^" POP=1 ;SD*5.3*412
  1. Q
  1. T1 ;
  1. I 'SDWLFLG,SDWLEXCL Q
  1. W !?20,"---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ----" ;SD*5.3*415
  1. W !,"Sub-Totals:"
  1. ;write sub-totals
  1. 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
  1. S (T1,T2,T3,T4,T5,T6,T7,T8,T9,T10,T11,T12)=0 ;SD*5.3*415
  1. I $Y>(IOSL-5) D:$D(SDWLSPT) SCR Q:POP D HD,HD1 ;SD*5.3*412
  1. Q
  1. T2 W !,"Institution Totals:"
  1. 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
  1. S (TT1,TT2,TT3,TT4,TT5,TT6,TT7,TT8,TT9,TT10,TT11,TT12)=0 ;SD*5.3*415
  1. I $Y>(IOSL-5) D:$D(SDWLSPT) SCR Q:POP D HD,HD1 ;SD*5.3*412
  1. Q
  1. GT ;Grand totals
  1. W !!,"Grand Totals:"
  1. 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),!
  1. Q
  1. 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
  1. W !,?80-$L("STARTED Date: ")\2,"STARTED Date: " S Y=$P(SDWLDATE,U,1) D DD^%DT W Y
  1. W !,?80-$L("FINISHED Date: ")\2,"FINISHED Date: " S Y=$P(SDWLDATE,U,2) D DD^%DT W Y
  1. Q
  1. HD1 ;
  1. W !,?20,"PREV"
  1. W ?65,"#"
  1. W ?75,"# NOT"
  1. W !,"WAIT LIST TYPE"
  1. 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
  1. Q
  1. END D EN^SDWLKIL
  1. K ^TMP("SDWLRSR1",$J),^TMP("SDWLRSR2",$J),SDWLY1,SDWLX1,SDWLRDT,CT,I
  1. 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
  1. 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
  1. K SDWLOK3,SDWLPR,SDWLPR,SDWLPROM,SDWLRE,SDWLRFDT,SDWLRR,SDWLSA,SDWLSCN,SDWLSCNM,SDWLTASK,SDWLTK,SDWLTNM,SDWLTYNM,SDWLTYP,X4,SDWLTR ;SD*5.3*415
  1. K GT1,GT2,GT3,GT4,GT5,GT6,GT7,GT8,GT9,GT10,GT11,GT12 ;SD*5.3*505
  1. K ZTSAVE,^XTMP("SDWLRSR"),INS,EXCL
  1. Q