- SDWLR31 ;BPOI/TEH - WAIT LIST REPORT 30/120 (PCMM) PRINT;06/12/2002 ; Compiled January 29, 2009 13:19:33
- ;;5.3;PIMS;**524,1015,1016**;JUN 30, 2012;Build 20
- ;
- ;
- ;
- ;
- ;
- 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
- SDWLR31 ;BPOI/TEH - WAIT LIST REPORT 30/120 (PCMM) PRINT;06/12/2002 ; Compiled January 29, 2009 13:19:33
- +1 ;;5.3;PIMS;**524,1015,1016**;JUN 30, 2012;Build 20
- +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
