SDWLR31 ;BPOI/TEH - WAIT LIST REPORT 30/120 (PCMM) PRINT;06/12/2002 ; Compiled January 29, 2009 13:19:33
;;5.3;scheduling;**524,538**;AUG 13 1993;Build 5
;
;
;
;
;
Q
EN ;ENTRY POINT
K ^TMP("SDWLR31",$J)
S SDWLJOB=$G(^TMP("SDWLR30","JOB"))
S %H=+$H D YMD^%DTC S SDWLDT=X
D SORT
D PRINT
K SDWLJOB,SDWLDT,SDWLINS,SDWLDATE,SDWLOPEN,X,S1,S2,S3,S1T,S2T,S3T,SDWLDA
K SDWLTY,SDWLTYP,SDWLFL,SDWLFLG
Q
SORT I SDWLJOB I $D(^TMP("SDWLR30",SDWLJOB)) S (SDWLINS,SDWLDATE,SDWLOPEN)="" N XX F XX="INS","DATE","OPEN" I $D(^TMP("SDWLR30",SDWLJOB,XX)) D
. S @("SDWL"_XX)=$G(^TMP("SDWLR30",SDWLJOB,XX))
E N YY F YY="INS","DATE","OPEN" S @("SDWL"_YY)=@YY
A0 I '$D(SDWLINS) Q
A1 I '$D(SDWLDATE) Q
A2 I '$D(SDWLOPEN) Q
I SDWLDATE'="ALL" S SDWLDATB=$P(SDWLDATE,U),SDWLDATE=$P(SDWLDATE,U,2)
A3 S SDWLDA=0 F S SDWLDA=$O(^SDWL(409.3,SDWLDA)) Q:SDWLDA<1 D
. S SDWLX=$G(^SDWL(409.3,SDWLDA,0))
. S SDWLIN=+$P(SDWLX,U,3) I SDWLINS'="ALL",SDWLINS'[SDWLIN Q
. S SDWLTY=+$P(SDWLX,U,5)
. 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)
. S SDWLSTAT=$P(SDWLX,U,17)
. I SDWLOPEN="O"&(SDWLOPEN'=SDWLSTAT) Q ; QUIT IF OPEN ONLY
. S SDWLORDT=$P(SDWLX,U,2)
. S SDWLDTQ=0 I $D(SDWLDATB) D
. . I SDWLORDT<SDWLDATB S SDWLDTQ=1 Q
. . I SDWLORDT>SDWLDATE S SDWLDTQ=1 Q
. I SDWLDTQ Q
. S SDWLFLG="O" I SDWLOPEN[SDWLSTAT,SDWLSTAT="C" D
. . S SDWLFLG="C-ND" I $G(^SDWL(409.3,SDWLDA,"DIS")) S SDWLFLG="C",SDWLORDT=$P(^SDWL(409.3,SDWLDA,"DIS"),U)
. S SDWLFLG=$S(SDWLFLG="O":1,SDWLFLG="C":2,1:3)
. S X1=SDWLDT,X2=SDWLORDT D ^%DTC S SDWLAPD=X
. I SDWLAPD<30 S SDWLFL=1
. I SDWLAPD>29&(SDWLAPD<120) S SDWLFL=2
. I SDWLAPD>120 S SDWLFL=3
. S SDWLCNT=0 I $D(^TMP("SDWLR31",$J,SDWLIN,SDWLFLG,SDWLFL,SDWLTY,SDWLTYP)) S SDWLCNT=^(SDWLTYP)
. S SDWLCNT=SDWLCNT+1 S ^TMP("SDWLR31",$J,SDWLIN,SDWLFLG,SDWLFL,SDWLTY,SDWLTYP)=SDWLCNT
. ;S ^TMP("SDWLR31",$J,"B",SDWLDA,SDWLFL,SDWLTY,SDWLTYP,SDWLFLG)=""
Q
PRINT ;PRINT REPORT
D HD
S (SDWLIN,SDWLTY,SDWLTYP,SDWLFL)=0,(S1,S2,S3)=0
B0 F S SDWLIN=$O(^TMP("SDWLR31",$J,SDWLIN)) Q:SDWLIN<1 D
.S (S1,S2,S3,S1T,S2T,S3T)=0
.S SDWLINX=$$GET1^DIQ(4,SDWLIN_",",.01) W !,$E(SDWLINX,1,20)," (",SDWLIN,")"
.S SDWLFLG=0
.F S SDWLFLG=$O(^TMP("SDWLR31",$J,SDWLIN,SDWLFLG)) Q:SDWLFLG<1 D D S2
..W ?22,$S(SDWLFLG=1:"(OPEN RECORDS)",SDWLFLG=2:"(CLOSED RECORDS)",SDWLFLG=3:"(CLOSED - WITH NO DISPOSITION RECORDED)",1:"UNKNOWN"),!!
..S SDWLFL=0
..F S SDWLFL=$O(^TMP("SDWLR31",$J,SDWLIN,SDWLFLG,SDWLFL)) Q:SDWLFL<1 D
...S SDWLTY=0
...F S SDWLTY=$O(^TMP("SDWLR31",$J,SDWLIN,SDWLFLG,SDWLFL,SDWLTY)) Q:SDWLTY<1 D D S1
....S SDWLTYX=$$EXTERNAL^DILFD(409.3,4,,SDWLTY) W ?22,$E(SDWLTYX,1,15)
....S SDWLTYP=0
....F S SDWLTYP=$O(^TMP("SDWLR31",$J,SDWLIN,SDWLFLG,SDWLFL,SDWLTY,SDWLTYP)) Q:SDWLTYP<1 D
.....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=""
.....S SDWLTYN=$$GET1^DIQ(SDWLF,SDWLTYP_",",.01) W ?40,$E(SDWLTYN,1,12)
.....S SDWLN=$G(^TMP("SDWLR31",$J,SDWLIN,SDWLFLG,SDWLFL,SDWLTY,SDWLTYP)) S @("S"_SDWLFL)=@("S"_SDWLFL)+SDWLN
.....S @("S"_SDWLFL_"T")=@("S"_SDWLFL_"T")+SDWLN
.....S TAB=$S(SDWLFL=1:55,SDWLFL=2:60,SDWLFL=3:65,1:65) D
......F SDX=1:1:3 D
.......S TAB=$S(SDX=1:55,SDX=2:60,SDX=3:65,1:65) D
........W ?TAB I SDX=SDWLFL W $J(SDWLN,$S(SDWLFL<3:3,1:4))
........E W ?TAB,$J(0,$S(SDX<3:3,1:4))
......W !
Q
S1 W !,?55,"===",?60,"===",?65,"====",!,?40,"SUBTOTALS"
W ?55,$J(S1,3),?60,$J(S2,3),?65,$J(S3,4) S (S1,S2,S3)=0 W !!
Q
S2 W !,?55,"===",?60,"===",?65,"====",!,?43,"TOTALS"
W ?55,$J(S1T,3),?60,$J(S2T,3),?65,$J(S3T,4),!!
Q
HD ;HEADER
W:$D(IOF) @IOF W !!,?80-$L("EWL 30/60/120 DAY REPORT")\2,"EWL 30/60/120 DAY REPORT",!!
W !,?5,"INSTITUTION",?25,"TYPE",?40,"LOCATION",?55,"<30",?60,">30",?65,">120"
W !,?5,"===========",?25,"====",?40,"========",?55,"===",?60,"===",?65,"====",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDWLR31 3944 printed Dec 13, 2024@03:03:05 Page 2
SDWLR31 ;BPOI/TEH - WAIT LIST REPORT 30/120 (PCMM) PRINT;06/12/2002 ; Compiled January 29, 2009 13:19:33
+1 ;;5.3;scheduling;**524,538**;AUG 13 1993;Build 5
+2 ;
+3 ;
+4 ;
+5 ;
+6 ;
+7 QUIT
EN ;ENTRY POINT
+1 KILL ^TMP("SDWLR31",$JOB)
+2 SET SDWLJOB=$GET(^TMP("SDWLR30","JOB"))
+3 SET %H=+$HOROLOG
DO YMD^%DTC
SET SDWLDT=X
+4 DO SORT
+5 DO PRINT
+6 KILL SDWLJOB,SDWLDT,SDWLINS,SDWLDATE,SDWLOPEN,X,S1,S2,S3,S1T,S2T,S3T,SDWLDA
+7 KILL SDWLTY,SDWLTYP,SDWLFL,SDWLFLG
+8 QUIT
SORT IF SDWLJOB
IF $DATA(^TMP("SDWLR30",SDWLJOB))
SET (SDWLINS,SDWLDATE,SDWLOPEN)=""
NEW XX
FOR XX="INS","DATE","OPEN"
IF $DATA(^TMP("SDWLR30",SDWLJOB,XX))
Begin DoDot:1
+1 SET @("SDWL"_XX)=$GET(^TMP("SDWLR30",SDWLJOB,XX))
End DoDot:1
+2 IF '$TEST
NEW YY
FOR YY="INS","DATE","OPEN"
SET @("SDWL"_YY)=@YY
A0 IF '$DATA(SDWLINS)
QUIT
A1 IF '$DATA(SDWLDATE)
QUIT
A2 IF '$DATA(SDWLOPEN)
QUIT
+1 IF SDWLDATE'="ALL"
SET SDWLDATB=$PIECE(SDWLDATE,U)
SET SDWLDATE=$PIECE(SDWLDATE,U,2)
A3 SET SDWLDA=0
FOR
SET SDWLDA=$ORDER(^SDWL(409.3,SDWLDA))
if SDWLDA<1
QUIT
Begin DoDot:1
+1 SET SDWLX=$GET(^SDWL(409.3,SDWLDA,0))
+2 SET SDWLIN=+$PIECE(SDWLX,U,3)
IF SDWLINS'="ALL"
IF SDWLINS'[SDWLIN
QUIT
+3 SET SDWLTY=+$PIECE(SDWLX,U,5)
+4 SET SDWLTYP=+$SELECT(SDWLTY=1:$PIECE(SDWLX,U,6),SDWLTY=2:$PIECE(SDWLX,U,7),SDWLTY=3:$PIECE(SDWLX,U,8),SDWLTY=4:$PIECE(SDWLX,U,9),1:0)
+5 SET SDWLSTAT=$PIECE(SDWLX,U,17)
+6 ; QUIT IF OPEN ONLY
IF SDWLOPEN="O"&(SDWLOPEN'=SDWLSTAT)
QUIT
+7 SET SDWLORDT=$PIECE(SDWLX,U,2)
+8 SET SDWLDTQ=0
IF $DATA(SDWLDATB)
Begin DoDot:2
+9 IF SDWLORDT<SDWLDATB
SET SDWLDTQ=1
QUIT
+10 IF SDWLORDT>SDWLDATE
SET SDWLDTQ=1
QUIT
End DoDot:2
+11 IF SDWLDTQ
QUIT
+12 SET SDWLFLG="O"
IF SDWLOPEN[SDWLSTAT
IF SDWLSTAT="C"
Begin DoDot:2
+13 SET SDWLFLG="C-ND"
IF $GET(^SDWL(409.3,SDWLDA,"DIS"))
SET SDWLFLG="C"
SET SDWLORDT=$PIECE(^SDWL(409.3,SDWLDA,"DIS"),U)
End DoDot:2
+14 SET SDWLFLG=$SELECT(SDWLFLG="O":1,SDWLFLG="C":2,1:3)
+15 SET X1=SDWLDT
SET X2=SDWLORDT
DO ^%DTC
SET SDWLAPD=X
+16 IF SDWLAPD<30
SET SDWLFL=1
+17 IF SDWLAPD>29&(SDWLAPD<120)
SET SDWLFL=2
+18 IF SDWLAPD>120
SET SDWLFL=3
+19 SET SDWLCNT=0
IF $DATA(^TMP("SDWLR31",$JOB,SDWLIN,SDWLFLG,SDWLFL,SDWLTY,SDWLTYP))
SET SDWLCNT=^(SDWLTYP)
+20 SET SDWLCNT=SDWLCNT+1
SET ^TMP("SDWLR31",$JOB,SDWLIN,SDWLFLG,SDWLFL,SDWLTY,SDWLTYP)=SDWLCNT
+21 ;S ^TMP("SDWLR31",$J,"B",SDWLDA,SDWLFL,SDWLTY,SDWLTYP,SDWLFLG)=""
End DoDot:1
+22 QUIT
PRINT ;PRINT REPORT
+1 DO HD
+2 SET (SDWLIN,SDWLTY,SDWLTYP,SDWLFL)=0
SET (S1,S2,S3)=0
B0 FOR
SET SDWLIN=$ORDER(^TMP("SDWLR31",$JOB,SDWLIN))
if SDWLIN<1
QUIT
Begin DoDot:1
+1 SET (S1,S2,S3,S1T,S2T,S3T)=0
+2 SET SDWLINX=$$GET1^DIQ(4,SDWLIN_",",.01)
WRITE !,$EXTRACT(SDWLINX,1,20)," (",SDWLIN,")"
+3 SET SDWLFLG=0
+4 FOR
SET SDWLFLG=$ORDER(^TMP("SDWLR31",$JOB,SDWLIN,SDWLFLG))
if SDWLFLG<1
QUIT
Begin DoDot:2
+5 WRITE ?22,$SELECT(SDWLFLG=1:"(OPEN RECORDS)",SDWLFLG=2:"(CLOSED RECORDS)",SDWLFLG=3:"(CLOSED - WITH NO DISPOSITION RECORDED)",1:"UNKNOWN"),!!
+6 SET SDWLFL=0
+7 FOR
SET SDWLFL=$ORDER(^TMP("SDWLR31",$JOB,SDWLIN,SDWLFLG,SDWLFL))
if SDWLFL<1
QUIT
Begin DoDot:3
+8 SET SDWLTY=0
+9 FOR
SET SDWLTY=$ORDER(^TMP("SDWLR31",$JOB,SDWLIN,SDWLFLG,SDWLFL,SDWLTY))
if SDWLTY<1
QUIT
Begin DoDot:4
+10 SET SDWLTYX=$$EXTERNAL^DILFD(409.3,4,,SDWLTY)
WRITE ?22,$EXTRACT(SDWLTYX,1,15)
+11 SET SDWLTYP=0
+12 FOR
SET SDWLTYP=$ORDER(^TMP("SDWLR31",$JOB,SDWLIN,SDWLFLG,SDWLFL,SDWLTY,SDWLTYP))
if SDWLTYP<1
QUIT
Begin DoDot:5
+13 SET SDWLF=$SELECT(SDWLTY=1:404.51,SDWLTY=2:404.57,SDWLTY=3:409.31,SDWLTY=4:409.32,1:0)
IF 'SDWLF
SET SDWLTYN=""
+14 SET SDWLTYN=$$GET1^DIQ(SDWLF,SDWLTYP_",",.01)
WRITE ?40,$EXTRACT(SDWLTYN,1,12)
+15 SET SDWLN=$GET(^TMP("SDWLR31",$JOB,SDWLIN,SDWLFLG,SDWLFL,SDWLTY,SDWLTYP))
SET @("S"_SDWLFL)=@("S"_SDWLFL)+SDWLN
+16 SET @("S"_SDWLFL_"T")=@("S"_SDWLFL_"T")+SDWLN
+17 SET TAB=$SELECT(SDWLFL=1:55,SDWLFL=2:60,SDWLFL=3:65,1:65)
Begin DoDot:6
+18 FOR SDX=1:1:3
Begin DoDot:7
+19 SET TAB=$SELECT(SDX=1:55,SDX=2:60,SDX=3:65,1:65)
Begin DoDot:8
+20 WRITE ?TAB
IF SDX=SDWLFL
WRITE $JUSTIFY(SDWLN,$SELECT(SDWLFL<3:3,1:4))
+21 IF '$TEST
WRITE ?TAB,$JUSTIFY(0,$SELECT(SDX<3:3,1:4))
End DoDot:8
End DoDot:7
+22 WRITE !
End DoDot:6
End DoDot:5
End DoDot:4
DO S1
End DoDot:3
End DoDot:2
DO S2
End DoDot:1
+23 QUIT
S1 WRITE !,?55,"===",?60,"===",?65,"====",!,?40,"SUBTOTALS"
+1 WRITE ?55,$JUSTIFY(S1,3),?60,$JUSTIFY(S2,3),?65,$JUSTIFY(S3,4)
SET (S1,S2,S3)=0
WRITE !!
+2 QUIT
S2 WRITE !,?55,"===",?60,"===",?65,"====",!,?43,"TOTALS"
+1 WRITE ?55,$JUSTIFY(S1T,3),?60,$JUSTIFY(S2T,3),?65,$JUSTIFY(S3T,4),!!
+2 QUIT
HD ;HEADER
+1 if $DATA(IOF)
WRITE @IOF
WRITE !!,?80-$LENGTH("EWL 30/60/120 DAY REPORT")\2,"EWL 30/60/120 DAY REPORT",!!
+2 WRITE !,?5,"INSTITUTION",?25,"TYPE",?40,"LOCATION",?55,"<30",?60,">30",?65,">120"
+3 WRITE !,?5,"===========",?25,"====",?40,"========",?55,"===",?60,"===",?65,"====",!
+4 QUIT
