- SDOQMPR ;LRVAMC/JRC ;ALB/SCK - Monitoring Report ; 7/17/96
- ;;5.3;SCHEDULING;**47,1015**;AUG 13, 1993;Build 21
- ; MODIFIED FOR NATIONAL RELEASE
- Q
- ;
- START U IO
- S (ALDCTOTL,ALDCNT)=0,$P(ALDCDASH,"-",133)=""
- S (END,PAGE)=0
- S $P(DASH,"=",132)=""
- S Y=DT D DD^%DT S ALDCNOW=Y
- S Y=$P($G(^TMP("SDPM",$J,0)),U) D DD^%DT S ALDCSTDT=Y
- S Y=$P($G(^TMP("SDPM",$J,0)),U,2) D DD^%DT S ALDCLAST=Y
- ;
- I '$D(^TMP("SDPM",$J,0)) D Q
- . D HEADER
- . W !!?5,"Either no appointment monitoring data found, or there was no data available for these clinics"
- ;
- K ^TMP($J)
- D SET,LOOP,KILL
- Q
- SET ;
- N PMDIV
- ;
- S ALDCIEN=0 F S ALDCIEN=$O(^TMP("SDPM",$J,ALDCIEN)) Q:ALDCIEN'>0 D
- .S ALDCDATE=0 F S ALDCDATE=$O(^TMP("SDPM",$J,ALDCIEN,ALDCDATE)) Q:ALDCDATE'>0 D
- ..Q:'$D(^SC(ALDCIEN,0))
- ..S ALDCNAME=$P(^SC(ALDCIEN,0),U)
- ..Q:$E(ALDCNAME,1,2)="ZZ" ;ZZ clinics
- ..S ALDCNCT=$P($G(^SC(ALDCIEN,0)),U,17) Q:ALDCNCT="Y" ;Non-Count Clincis
- ..S ALDCSTOP="UNKNOWN",ALDCSCD=$P($G(^SC(ALDCIEN,0)),U,7) S:ALDCSCD]"" ALDCSTOP=$P($G(^DIC(40.7,+ALDCSCD,0)),U)
- .. Q:+$P($G(^DIC(40.7,+ALDCSCD,0)),U,2)=0
- .. S ALDCODE=$P($G(^DIC(40.7,+ALDCSCD,0)),U,2)
- .. S ALDCGET=$G(^TMP("SDPM",$J,ALDCIEN,ALDCDATE))
- .. S PMDIV=$P(ALDCGET,U,7) S:PMDIV']"" PMDIV="ND" ;Get Division
- .. S ALDCGET=$P(ALDCGET,U,1,6) ;Remove division
- .. S ^TMP($J,PMDIV,ALDCSTOP,ALDCNAME,ALDCDATE,ALDCIEN)=ALDCGET_U_ALDCODE
- Q
- ;
- LOOP ;
- N PMDIV
- S (ALDCNT,ALDCTOTL,ALDC2T,ALDCSLTA,ALDCDAYT,ALDCDAYS,ALDCAVG,ALDCOPEN,ALDCOST,ALDC2,ALDC3T,ALDC4T,ALDC4A,ALDC3A,ALDC5,ALDC5T,ALDC5A,ALDC6,ALDC6T,ALDC6A,ALDCOB)=0
- ;
- S PMDIV="" F S PMDIV=$O(^TMP($J,PMDIV)) Q:PMDIV="" D Q:END
- . D HEADER
- . S ALDCSTOP="" F S ALDCSTOP=$O(^TMP($J,PMDIV,ALDCSTOP)) Q:ALDCSTOP="" D Q:END
- .. D HDR2
- .. S ALDCNAME="",ALDCLINE=0 F S ALDCNAME=$O(^TMP($J,PMDIV,ALDCSTOP,ALDCNAME)) Q:ALDCNAME="" D Q:END
- ...S ALDCDATE=0 F S ALDCDATE=$O(^TMP($J,PMDIV,ALDCSTOP,ALDCNAME,ALDCDATE)) Q:ALDCDATE'>0 D Q:END
- ....S ALDCIEN=0 F S ALDCIEN=$O(^TMP($J,PMDIV,ALDCSTOP,ALDCNAME,ALDCDATE,ALDCIEN)) Q:ALDCIEN'>0 D Q:END
- .....S ALDCGET=$G(^TMP($J,PMDIV,ALDCSTOP,ALDCNAME,ALDCDATE,ALDCIEN))
- .....S ALDC1=$P(ALDCGET,U),ALDC2=$P(ALDCGET,U,2),ALDC3=$P(ALDCGET,U,3),ALDC4=$P(ALDCGET,U,4),ALDC5=$P(ALDCGET,U,5),ALDC6=$P(ALDCGET,U,6),ALDCD=" ("_$P(ALDCGET,U,7)_") ",ALDCPSTP=" "_ALDCSTOP_ALDCD
- .....K ALDCSTAR S ALDCWK=66-($L(ALDCPSTP)*.5),$P(ALDCSTAR,"*",ALDCWK)="",ALDCPSTP=ALDCSTAR_ALDCPSTP_ALDCSTAR
- .....S:ALDC2>0 ALDCOPEN=ALDCOPEN+1
- .....S ALDC2T=ALDC2T+ALDC2 ;# slots on run date
- .....S ALDC3T=ALDC3T+ALDC3 ;# appts on run date
- .....S ALDC4T=ALDC4T+ALDC4 ;# slots from run date to first avlbe appt
- .....S ALDC5T=ALDC5T+ALDC5 ;# appts from run date to first avlbe appt
- .....S ALDC6T=ALDC6T+ALDC6 ;# of open days (days clinic held)
- .....D ADD
- .....S ALDCNT=ALDCNT+1
- .... D:$Y+5>IOSL HEADER Q:END
- ....W:ALDCSTOP'=ALDCOST !!,ALDCPSTP
- ....S ALDCOST=ALDCSTOP
- ...S ALDCTOTL=ALDCTOTL+ALDCNT
- ...S ALDC4A=ALDC4T/ALDCNT ;average slots to first available appt
- ...S ALDC5A=ALDC5T/ALDCNT ;average appts to first available appt
- ...S ALDC6A=ALDC6T/ALDCNT ;average open days (days clinic is held)
- ...I (ALDC3T>0)&(ALDCOPEN>0) S ALDC3A=ALDC3T/ALDCOPEN ;avg appts
- ...I (ALDC2T>0)&(ALDCOPEN>0) S ALDCSLTA=ALDC2T/ALDCOPEN ;avg slots
- ...I (ALDC4A>0)&(ALDC5A>0) S ALDCOB=ALDC5A/ALDC4A ;overbooks
- ...S ALDCAVG=ALDCDAYT/ALDCNT
- ...I ALDCLINE=3 W ! S ALDCLINE=0
- ...W !,?2,$E(ALDCNAME,1,23),?30,$J(ALDCAVG,6,2),?42,$J(ALDCSLTA,6,2),?55,$J(ALDC3A,6,2),?70,$J(ALDC4A,6,2),?82,$J(ALDC5A,6,2),?95,$J(ALDC6A,6,2),?107,$J(ALDCOPEN,6),?120,$J(ALDCOB,6,2)
- ...S ALDCLINE=ALDCLINE+1
- ...S (ALDCNT,ALDCDAYS,ALDCDAYT,ALDC2T,ALDC3T,ALDC4T,ALDCOPEN,ALDCSLTA,ALDC3A,ALDC4A,ALDC5,ALDC5A,ALDC5T,ALDC6,ALDC6T,ALDC6A,ALDCOB)=0
- Q
- ADD ;Calculate number of days to next available appointment
- S X2=ALDCDATE,X1=ALDC1 D ^%DTC S ALDCDAYS=X
- S ALDCDAYT=ALDCDAYT+ALDCDAYS
- Q
- I PAGE,$E(IOST,1,2)="C-" W !,"Press RETURN to continue or '^' to exit: " R X:DTIME S END='$T!(X="^") Q:END
- HDR1 W:$E(IOST,1,2)'="C-" @IOF
- S PAGE=PAGE+1
- W !?110,"Run Date: ",ALDCNOW
- W !?3,"OUTPATIENT CLINIC WAITING TIME PROJECT from "_ALDCSTDT_" thru "_ALDCLAST,?114,"PAGE: ",PAGE,!
- W !?32,"[****************************** AVERAGE ******************************]"
- W !,?70,"SLOTS TO",?82,"APPTS TO",?95,"OPEN"
- W !,?32,"WAIT",?55,"APPTS",?70,"FIRST",?82,"FIRST",?95,"DAYS TO",?120,"OVER"
- W !,?32,"IN",?42,"SLOTS PER",?55,"PER OPEN",?70,"AVAIL",?82,"AVAIL",?95,"FIRST",?109,"OPEN",?120,"BOOK"
- W !?5,"Clinic",?32,"DAYS",?42,"OPEN DAY",?55,"DAY",?70,"APPT",?82,"APPT",?95,"APPT",?109,"DAYS",?120,"RATE"
- W !,DASH
- W !!,"DIVSION: ",$S(+PMDIV>0:$P($G(^DG(40.8,PMDIV,0)),U),1:"None Specified")
- Q
- ;
- HDR2 W:ALDCSTOP=ALDCOST !!,ALDCPSTP
- S ALDCLINE=0
- Q
- ;
- KILL K X,Y,ALDCDATE,ALDC1,ALDCSTDT,ALDCLAST,ALDCNT,ALDCDAYT,ALDC3T,ALDCSTOP,ALDCOST,ALDCPAGE,ALDC2,ALDC3,ALDC4,ALDC5,ALDC6,ALDC2T
- K ALDCAVG,ALDCDASH,ALDCDAYS,X1,X2,ALDCGET,ALDCIEN,ALDCNAME,ALDCOPEN,ALDCSCD,ALDCSLTA,ALDCTOTL,ALDCNCT,ALDC3A,ALDC4A,ALDC5A
- K ALDC6A,ALDC4T,ALDC5T,ALDC6T,ALDCOB
- K ^TMP($J)
- Q
- SDOQMPR ;LRVAMC/JRC ;ALB/SCK - Monitoring Report ; 7/17/96
- +1 ;;5.3;SCHEDULING;**47,1015**;AUG 13, 1993;Build 21
- +2 ; MODIFIED FOR NATIONAL RELEASE
- +3 QUIT
- +4 ;
- START USE IO
- +1 SET (ALDCTOTL,ALDCNT)=0
- SET $PIECE(ALDCDASH,"-",133)=""
- +2 SET (END,PAGE)=0
- +3 SET $PIECE(DASH,"=",132)=""
- +4 SET Y=DT
- DO DD^%DT
- SET ALDCNOW=Y
- +5 SET Y=$PIECE($GET(^TMP("SDPM",$JOB,0)),U)
- DO DD^%DT
- SET ALDCSTDT=Y
- +6 SET Y=$PIECE($GET(^TMP("SDPM",$JOB,0)),U,2)
- DO DD^%DT
- SET ALDCLAST=Y
- +7 ;
- +8 IF '$DATA(^TMP("SDPM",$JOB,0))
- Begin DoDot:1
- +9 DO HEADER
- +10 WRITE !!?5,"Either no appointment monitoring data found, or there was no data available for these clinics"
- End DoDot:1
- QUIT
- +11 ;
- +12 KILL ^TMP($JOB)
- +13 DO SET
- DO LOOP
- DO KILL
- +14 QUIT
- SET ;
- +1 NEW PMDIV
- +2 ;
- +3 SET ALDCIEN=0
- FOR
- SET ALDCIEN=$ORDER(^TMP("SDPM",$JOB,ALDCIEN))
- IF ALDCIEN'>0
- QUIT
- Begin DoDot:1
- +4 SET ALDCDATE=0
- FOR
- SET ALDCDATE=$ORDER(^TMP("SDPM",$JOB,ALDCIEN,ALDCDATE))
- IF ALDCDATE'>0
- QUIT
- Begin DoDot:2
- +5 IF '$DATA(^SC(ALDCIEN,0))
- QUIT
- +6 SET ALDCNAME=$PIECE(^SC(ALDCIEN,0),U)
- +7 ;ZZ clinics
- IF $EXTRACT(ALDCNAME,1,2)="ZZ"
- QUIT
- +8 ;Non-Count Clincis
- SET ALDCNCT=$PIECE($GET(^SC(ALDCIEN,0)),U,17)
- IF ALDCNCT="Y"
- QUIT
- +9 SET ALDCSTOP="UNKNOWN"
- SET ALDCSCD=$PIECE($GET(^SC(ALDCIEN,0)),U,7)
- IF ALDCSCD]""
- SET ALDCSTOP=$PIECE($GET(^DIC(40.7,+ALDCSCD,0)),U)
- +10 IF +$PIECE($GET(^DIC(40.7,+ALDCSCD,0)),U,2)=0
- QUIT
- +11 SET ALDCODE=$PIECE($GET(^DIC(40.7,+ALDCSCD,0)),U,2)
- +12 SET ALDCGET=$GET(^TMP("SDPM",$JOB,ALDCIEN,ALDCDATE))
- +13 ;Get Division
- SET PMDIV=$PIECE(ALDCGET,U,7)
- IF PMDIV']""
- SET PMDIV="ND"
- +14 ;Remove division
- SET ALDCGET=$PIECE(ALDCGET,U,1,6)
- +15 SET ^TMP($JOB,PMDIV,ALDCSTOP,ALDCNAME,ALDCDATE,ALDCIEN)=ALDCGET_U_ALDCODE
- End DoDot:2
- End DoDot:1
- +16 QUIT
- +17 ;
- LOOP ;
- +1 NEW PMDIV
- +2 SET (ALDCNT,ALDCTOTL,ALDC2T,ALDCSLTA,ALDCDAYT,ALDCDAYS,ALDCAVG,ALDCOPEN,ALDCOST,ALDC2,ALDC3T,ALDC4T,ALDC4A,ALDC3A,ALDC5,ALDC5T,ALDC5A,ALDC6,ALDC6T,ALDC6A,ALDCOB)=0
- +3 ;
- +4 SET PMDIV=""
- FOR
- SET PMDIV=$ORDER(^TMP($JOB,PMDIV))
- IF PMDIV=""
- QUIT
- Begin DoDot:1
- +5 DO HEADER
- +6 SET ALDCSTOP=""
- FOR
- SET ALDCSTOP=$ORDER(^TMP($JOB,PMDIV,ALDCSTOP))
- IF ALDCSTOP=""
- QUIT
- Begin DoDot:2
- +7 DO HDR2
- +8 SET ALDCNAME=""
- SET ALDCLINE=0
- FOR
- SET ALDCNAME=$ORDER(^TMP($JOB,PMDIV,ALDCSTOP,ALDCNAME))
- IF ALDCNAME=""
- QUIT
- Begin DoDot:3
- +9 SET ALDCDATE=0
- FOR
- SET ALDCDATE=$ORDER(^TMP($JOB,PMDIV,ALDCSTOP,ALDCNAME,ALDCDATE))
- IF ALDCDATE'>0
- QUIT
- Begin DoDot:4
- +10 SET ALDCIEN=0
- FOR
- SET ALDCIEN=$ORDER(^TMP($JOB,PMDIV,ALDCSTOP,ALDCNAME,ALDCDATE,ALDCIEN))
- IF ALDCIEN'>0
- QUIT
- Begin DoDot:5
- +11 SET ALDCGET=$GET(^TMP($JOB,PMDIV,ALDCSTOP,ALDCNAME,ALDCDATE,ALDCIEN))
- +12 SET ALDC1=$PIECE(ALDCGET,U)
- SET ALDC2=$PIECE(ALDCGET,U,2)
- SET ALDC3=$PIECE(ALDCGET,U,3)
- SET ALDC4=$PIECE(ALDCGET,U,4)
- SET ALDC5=$PIECE(ALDCGET,U,5)
- SET ALDC6=$PIECE(ALDCGET,U,6)
- SET ALDCD=" ("_$PIECE(ALDCGET,U,7)_") "
- SET ALDCPSTP=" "_ALDCSTOP_ALDCD
- +13 KILL ALDCSTAR
- SET ALDCWK=66-($LENGTH(ALDCPSTP)*.5)
- SET $PIECE(ALDCSTAR,"*",ALDCWK)=""
- SET ALDCPSTP=ALDCSTAR_ALDCPSTP_ALDCSTAR
- +14 IF ALDC2>0
- SET ALDCOPEN=ALDCOPEN+1
- +15 ;# slots on run date
- SET ALDC2T=ALDC2T+ALDC2
- +16 ;# appts on run date
- SET ALDC3T=ALDC3T+ALDC3
- +17 ;# slots from run date to first avlbe appt
- SET ALDC4T=ALDC4T+ALDC4
- +18 ;# appts from run date to first avlbe appt
- SET ALDC5T=ALDC5T+ALDC5
- +19 ;# of open days (days clinic held)
- SET ALDC6T=ALDC6T+ALDC6
- +20 DO ADD
- +21 SET ALDCNT=ALDCNT+1
- End DoDot:5
- IF END
- QUIT
- +22 IF $Y+5>IOSL
- DO HEADER
- IF END
- QUIT
- +23 IF ALDCSTOP'=ALDCOST
- WRITE !!,ALDCPSTP
- +24 SET ALDCOST=ALDCSTOP
- End DoDot:4
- IF END
- QUIT
- +25 SET ALDCTOTL=ALDCTOTL+ALDCNT
- +26 ;average slots to first available appt
- SET ALDC4A=ALDC4T/ALDCNT
- +27 ;average appts to first available appt
- SET ALDC5A=ALDC5T/ALDCNT
- +28 ;average open days (days clinic is held)
- SET ALDC6A=ALDC6T/ALDCNT
- +29 ;avg appts
- IF (ALDC3T>0)&(ALDCOPEN>0)
- SET ALDC3A=ALDC3T/ALDCOPEN
- +30 ;avg slots
- IF (ALDC2T>0)&(ALDCOPEN>0)
- SET ALDCSLTA=ALDC2T/ALDCOPEN
- +31 ;overbooks
- IF (ALDC4A>0)&(ALDC5A>0)
- SET ALDCOB=ALDC5A/ALDC4A
- +32 SET ALDCAVG=ALDCDAYT/ALDCNT
- +33 IF ALDCLINE=3
- WRITE !
- SET ALDCLINE=0
- +34 WRITE !,?2,$EXTRACT(ALDCNAME,1,23),?30,$JUSTIFY(ALDCAVG,6,2),?42,$JUSTIFY(ALDCSLTA,6,2),?55,$JUSTIFY(ALDC3A,6,2),?70,$JUSTIFY(ALDC4A,6,2),?82,$JUSTIFY(ALDC5A,6,2),?95,$JUSTIFY(ALDC6A,6,2),?107,$JUSTIFY(ALDCOPEN,6),?120,$
- JUSTIFY(ALDCOB,6,2)
- +35 SET ALDCLINE=ALDCLINE+1
- +36 SET (ALDCNT,ALDCDAYS,ALDCDAYT,ALDC2T,ALDC3T,ALDC4T,ALDCOPEN,ALDCSLTA,ALDC3A,ALDC4A,ALDC5,ALDC5A,ALDC5T,ALDC6,ALDC6T,ALDC6A,ALDCOB)=0
- End DoDot:3
- IF END
- QUIT
- End DoDot:2
- IF END
- QUIT
- End DoDot:1
- IF END
- QUIT
- +37 QUIT
- ADD ;Calculate number of days to next available appointment
- +1 SET X2=ALDCDATE
- SET X1=ALDC1
- DO ^%DTC
- SET ALDCDAYS=X
- +2 SET ALDCDAYT=ALDCDAYT+ALDCDAYS
- +3 QUIT
- +1 IF PAGE
- IF $EXTRACT(IOST,1,2)="C-"
- WRITE !,"Press RETURN to continue or '^' to exit: "
- READ X:DTIME
- SET END='$TEST!(X="^")
- IF END
- QUIT
- HDR1 IF $EXTRACT(IOST,1,2)'="C-"
- WRITE @IOF
- +1 SET PAGE=PAGE+1
- +2 WRITE !?110,"Run Date: ",ALDCNOW
- +3 WRITE !?3,"OUTPATIENT CLINIC WAITING TIME PROJECT from "_ALDCSTDT_" thru "_ALDCLAST,?114,"PAGE: ",PAGE,!
- +4 WRITE !?32,"[****************************** AVERAGE ******************************]"
- +5 WRITE !,?70,"SLOTS TO",?82,"APPTS TO",?95,"OPEN"
- +6 WRITE !,?32,"WAIT",?55,"APPTS",?70,"FIRST",?82,"FIRST",?95,"DAYS TO",?120,"OVER"
- +7 WRITE !,?32,"IN",?42,"SLOTS PER",?55,"PER OPEN",?70,"AVAIL",?82,"AVAIL",?95,"FIRST",?109,"OPEN",?120,"BOOK"
- +8 WRITE !?5,"Clinic",?32,"DAYS",?42,"OPEN DAY",?55,"DAY",?70,"APPT",?82,"APPT",?95,"APPT",?109,"DAYS",?120,"RATE"
- +9 WRITE !,DASH
- +10 WRITE !!,"DIVSION: ",$SELECT(+PMDIV>0:$PIECE($GET(^DG(40.8,PMDIV,0)),U),1:"None Specified")
- +11 QUIT
- +12 ;
- HDR2 IF ALDCSTOP=ALDCOST
- WRITE !!,ALDCPSTP
- +1 SET ALDCLINE=0
- +2 QUIT
- +3 ;
- KILL KILL X,Y,ALDCDATE,ALDC1,ALDCSTDT,ALDCLAST,ALDCNT,ALDCDAYT,ALDC3T,ALDCSTOP,ALDCOST,ALDCPAGE,ALDC2,ALDC3,ALDC4,ALDC5,ALDC6,ALDC2T
- +1 KILL ALDCAVG,ALDCDASH,ALDCDAYS,X1,X2,ALDCGET,ALDCIEN,ALDCNAME,ALDCOPEN,ALDCSCD,ALDCSLTA,ALDCTOTL,ALDCNCT,ALDC3A,ALDC4A,ALDC5A
- +2 KILL ALDC6A,ALDC4T,ALDC5T,ALDC6T,ALDCOB
- +3 KILL ^TMP($JOB)
- +4 QUIT
