source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDOQMPR.m@ 731

Last change on this file since 731 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.9 KB
Line 
1SDOQMPR ;LRVAMC/JRC ;ALB/SCK - Monitoring Report ; 7/17/96
2 ;;5.3;SCHEDULING;**47**;AUG 13, 1993
3 ; MODIFIED FOR NATIONAL RELEASE
4 Q
5 ;
6START U IO
7 S (ALDCTOTL,ALDCNT)=0,$P(ALDCDASH,"-",133)=""
8 S (END,PAGE)=0
9 S $P(DASH,"=",132)=""
10 S Y=DT D DD^%DT S ALDCNOW=Y
11 S Y=$P($G(^TMP("SDPM",$J,0)),U) D DD^%DT S ALDCSTDT=Y
12 S Y=$P($G(^TMP("SDPM",$J,0)),U,2) D DD^%DT S ALDCLAST=Y
13 ;
14 I '$D(^TMP("SDPM",$J,0)) D Q
15 . D HEADER
16 . W !!?5,"Either no appointment monitoring data found, or there was no data available for these clinics"
17 ;
18 K ^TMP($J)
19 D SET,LOOP,KILL
20 Q
21SET ;
22 N PMDIV
23 ;
24 S ALDCIEN=0 F S ALDCIEN=$O(^TMP("SDPM",$J,ALDCIEN)) Q:ALDCIEN'>0 D
25 .S ALDCDATE=0 F S ALDCDATE=$O(^TMP("SDPM",$J,ALDCIEN,ALDCDATE)) Q:ALDCDATE'>0 D
26 ..Q:'$D(^SC(ALDCIEN,0))
27 ..S ALDCNAME=$P(^SC(ALDCIEN,0),U)
28 ..Q:$E(ALDCNAME,1,2)="ZZ" ;ZZ clinics
29 ..S ALDCNCT=$P($G(^SC(ALDCIEN,0)),U,17) Q:ALDCNCT="Y" ;Non-Count Clincis
30 ..S ALDCSTOP="UNKNOWN",ALDCSCD=$P($G(^SC(ALDCIEN,0)),U,7) S:ALDCSCD]"" ALDCSTOP=$P($G(^DIC(40.7,+ALDCSCD,0)),U)
31 .. Q:+$P($G(^DIC(40.7,+ALDCSCD,0)),U,2)=0
32 .. S ALDCODE=$P($G(^DIC(40.7,+ALDCSCD,0)),U,2)
33 .. S ALDCGET=$G(^TMP("SDPM",$J,ALDCIEN,ALDCDATE))
34 .. S PMDIV=$P(ALDCGET,U,7) S:PMDIV']"" PMDIV="ND" ;Get Division
35 .. S ALDCGET=$P(ALDCGET,U,1,6) ;Remove division
36 .. S ^TMP($J,PMDIV,ALDCSTOP,ALDCNAME,ALDCDATE,ALDCIEN)=ALDCGET_U_ALDCODE
37 Q
38 ;
39LOOP ;
40 N PMDIV
41 S (ALDCNT,ALDCTOTL,ALDC2T,ALDCSLTA,ALDCDAYT,ALDCDAYS,ALDCAVG,ALDCOPEN,ALDCOST,ALDC2,ALDC3T,ALDC4T,ALDC4A,ALDC3A,ALDC5,ALDC5T,ALDC5A,ALDC6,ALDC6T,ALDC6A,ALDCOB)=0
42 ;
43 S PMDIV="" F S PMDIV=$O(^TMP($J,PMDIV)) Q:PMDIV="" D Q:END
44 . D HEADER
45 . S ALDCSTOP="" F S ALDCSTOP=$O(^TMP($J,PMDIV,ALDCSTOP)) Q:ALDCSTOP="" D Q:END
46 .. D HDR2
47 .. S ALDCNAME="",ALDCLINE=0 F S ALDCNAME=$O(^TMP($J,PMDIV,ALDCSTOP,ALDCNAME)) Q:ALDCNAME="" D Q:END
48 ...S ALDCDATE=0 F S ALDCDATE=$O(^TMP($J,PMDIV,ALDCSTOP,ALDCNAME,ALDCDATE)) Q:ALDCDATE'>0 D Q:END
49 ....S ALDCIEN=0 F S ALDCIEN=$O(^TMP($J,PMDIV,ALDCSTOP,ALDCNAME,ALDCDATE,ALDCIEN)) Q:ALDCIEN'>0 D Q:END
50 .....S ALDCGET=$G(^TMP($J,PMDIV,ALDCSTOP,ALDCNAME,ALDCDATE,ALDCIEN))
51 .....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
52 .....K ALDCSTAR S ALDCWK=66-($L(ALDCPSTP)*.5),$P(ALDCSTAR,"*",ALDCWK)="",ALDCPSTP=ALDCSTAR_ALDCPSTP_ALDCSTAR
53 .....S:ALDC2>0 ALDCOPEN=ALDCOPEN+1
54 .....S ALDC2T=ALDC2T+ALDC2 ;# slots on run date
55 .....S ALDC3T=ALDC3T+ALDC3 ;# appts on run date
56 .....S ALDC4T=ALDC4T+ALDC4 ;# slots from run date to first avlbe appt
57 .....S ALDC5T=ALDC5T+ALDC5 ;# appts from run date to first avlbe appt
58 .....S ALDC6T=ALDC6T+ALDC6 ;# of open days (days clinic held)
59 .....D ADD
60 .....S ALDCNT=ALDCNT+1
61 .... D:$Y+5>IOSL HEADER Q:END
62 ....W:ALDCSTOP'=ALDCOST !!,ALDCPSTP
63 ....S ALDCOST=ALDCSTOP
64 ...S ALDCTOTL=ALDCTOTL+ALDCNT
65 ...S ALDC4A=ALDC4T/ALDCNT ;average slots to first available appt
66 ...S ALDC5A=ALDC5T/ALDCNT ;average appts to first available appt
67 ...S ALDC6A=ALDC6T/ALDCNT ;average open days (days clinic is held)
68 ...I (ALDC3T>0)&(ALDCOPEN>0) S ALDC3A=ALDC3T/ALDCOPEN ;avg appts
69 ...I (ALDC2T>0)&(ALDCOPEN>0) S ALDCSLTA=ALDC2T/ALDCOPEN ;avg slots
70 ...I (ALDC4A>0)&(ALDC5A>0) S ALDCOB=ALDC5A/ALDC4A ;overbooks
71 ...S ALDCAVG=ALDCDAYT/ALDCNT
72 ...I ALDCLINE=3 W ! S ALDCLINE=0
73 ...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)
74 ...S ALDCLINE=ALDCLINE+1
75 ...S (ALDCNT,ALDCDAYS,ALDCDAYT,ALDC2T,ALDC3T,ALDC4T,ALDCOPEN,ALDCSLTA,ALDC3A,ALDC4A,ALDC5,ALDC5A,ALDC5T,ALDC6,ALDC6T,ALDC6A,ALDCOB)=0
76 Q
77ADD ;Calculate number of days to next available appointment
78 S X2=ALDCDATE,X1=ALDC1 D ^%DTC S ALDCDAYS=X
79 S ALDCDAYT=ALDCDAYT+ALDCDAYS
80 Q
81HEADER ;
82 I PAGE,$E(IOST,1,2)="C-" W !,"Press RETURN to continue or '^' to exit: " R X:DTIME S END='$T!(X="^") Q:END
83HDR1 W:$E(IOST,1,2)'="C-" @IOF
84 S PAGE=PAGE+1
85 W !?110,"Run Date: ",ALDCNOW
86 W !?3,"OUTPATIENT CLINIC WAITING TIME PROJECT from "_ALDCSTDT_" thru "_ALDCLAST,?114,"PAGE: ",PAGE,!
87 W !?32,"[****************************** AVERAGE ******************************]"
88 W !,?70,"SLOTS TO",?82,"APPTS TO",?95,"OPEN"
89 W !,?32,"WAIT",?55,"APPTS",?70,"FIRST",?82,"FIRST",?95,"DAYS TO",?120,"OVER"
90 W !,?32,"IN",?42,"SLOTS PER",?55,"PER OPEN",?70,"AVAIL",?82,"AVAIL",?95,"FIRST",?109,"OPEN",?120,"BOOK"
91 W !?5,"Clinic",?32,"DAYS",?42,"OPEN DAY",?55,"DAY",?70,"APPT",?82,"APPT",?95,"APPT",?109,"DAYS",?120,"RATE"
92 W !,DASH
93 W !!,"DIVSION: ",$S(+PMDIV>0:$P($G(^DG(40.8,PMDIV,0)),U),1:"None Specified")
94 Q
95 ;
96HDR2 W:ALDCSTOP=ALDCOST !!,ALDCPSTP
97 S ALDCLINE=0
98 Q
99 ;
100KILL K X,Y,ALDCDATE,ALDC1,ALDCSTDT,ALDCLAST,ALDCNT,ALDCDAYT,ALDC3T,ALDCSTOP,ALDCOST,ALDCPAGE,ALDC2,ALDC3,ALDC4,ALDC5,ALDC6,ALDC2T
101 K ALDCAVG,ALDCDASH,ALDCDAYS,X1,X2,ALDCGET,ALDCIEN,ALDCNAME,ALDCOPEN,ALDCSCD,ALDCSLTA,ALDCTOTL,ALDCNCT,ALDC3A,ALDC4A,ALDC5A
102 K ALDC6A,ALDC4T,ALDC5T,ALDC6T,ALDCOB
103 K ^TMP($J)
104 Q
Note: See TracBrowser for help on using the repository browser.