source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPW6.m@ 677

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

initial load of FOIAVistA 6/30/08 version
File size: 6.0 KB
Line 
1SCRPW6 ;RENO/KEITH - Trend of Facility Uniques by 12 Month Date Ranges ; 15 Jul 98 02:38PM
2 ;;5.3;Scheduling;**139,144,466,510**;AUG 13, 1993;Build 3
3 N SDDIV,SDI,SDSTA,DIR D TITL^SCRPW50("Trend of Facility Uniques by 12 Month Date Ranges") G:'$$DIVA^SCRPW17(.SDDIV) EXIT
4 D SUBT^SCRPW50("**** Status Selection ****")
5 S DIR(0)="S^1:Checked Out (Outpatients);2:Checked Out (Inpatients);3:Checked Out (Out/Inpatients)",DIR("A")="Select Status",DIR("B")="1"
6 D ^DIR I $D(DTOUT)!$D(DUOUT)!(+Y<0) G EXIT
7 S SDSTA=$S(Y=1:2,Y=2:8,1:"2^8")
8QUE W !!,"This report requires 132 column output.",!
9 N ZTSAVE F X="SDDIV","SDDIV(","SDDNU(","SDSTA" S ZTSAVE(X)=""
10 D EN^XUTMDEVQ("UNIQ^SCRPW6","Trend Facility Uniques",.ZTSAVE),DISP0^SCRPW23 Q
11UNIQ ;Calculate/print uniques
12 S (SDOUT,SDSTOP)=0,SDLINE="",SDPAGE=1,$P(SDLINE,"-",133)="" D NOW^%DTC S Y=% X ^DD("DD") S SDPNOW=$P(Y,":",1,2),SDMD=$O(SDDIV(0)),SDMD=$O(SDDIV(SDMD)) S:$P(SDDIV,U,2)="ALL DIVISIONS" SDMD=1
13 K ^TMP("SCRPW",$J) S SDBDT=$E(DT,1,3)-5_$E(DT,4,5)_"00",SDEDT=$E(DT,1,5)_"00",SDXEDT=$E(DT,1,3)-1_$E(DT,4,5)_"00" D OENC G:SDOUT EXIT
14 S SDIV="" F S SDIV=$O(^TMP("SCRPW",$J,SDIV)) Q:SDIV="" D STOP Q:SDOUT D
15 .S SDDT=SDBDT,SDXDT=$$YDTINC(SDDT),^TMP("SCRPW",$J,SDIV,"YR","MAX")=0 D LOOK
16 .F S SDDT=$$DTINC(SDDT) Q:SDDT>SDXEDT S SDXDT=$$YDTINC(SDDT) D LOOK I ^TMP("SCRPW",$J,SDIV,"YR",SDDT)>^TMP("SCRPW",$J,SDIV,"YR","MAX") S ^TMP("SCRPW",$J,SDIV,"YR","MAX")=^TMP("SCRPW",$J,SDIV,"YR",SDDT)
17 G:SDOUT EXIT D:$E(IOST)="C" DISP0^SCRPW23 I '$D(^TMP("SCRPW",$J)) D HDR G:SDOUT EXIT S SDX="No activity found within selected report parameters!" W !!?(IOM-$L(SDX)\2),SDX G EXIT
18 I $P(SDDIV,U,2)="SELECTED DIVISIONS" D
19 .S SDI=0 F S SDI=$O(SDDIV(SDI)) Q:'SDI S SDIV(SDDIV(SDI))=SDI
20 .Q
21 I $P(SDDIV,U,2)="ALL DIVISIONS" D
22 .S SDI=0 F S SDI=$O(^TMP("SCRPW",$J,SDI)) Q:'SDI S SDX=$P($G(^DG(40.8,SDI,0)),U) S:'$L(SDX) SDX="***UNKNOWN***" S SDIV(SDX)=SDI
23 .Q
24 S:$D(SDIV)'>1 SDIV($P(SDDIV,U,2))=$P(SDDIV,U,3)
25 G:SDOUT EXIT D:$E(IOST)="C" DISP0^SCRPW23 S SDIVN="" F S SDIVN=$O(SDIV(SDIVN)) Q:SDIVN=""!SDOUT S SDIV=SDIV(SDIVN) D DPRT(.SDIV)
26 G:SDOUT EXIT S SDMD=0,SDMD=$O(^TMP("SCRPW",$J,SDMD)),SDMD=$O(^TMP("SCRPW",$J,SDMD)) I SDMD S SDIV=0 D DPRT(.SDIV)
27 I $E(IOST)="C",'SDOUT W ! N DIR S DIR(0)="E" D ^DIR
28 ;
29EXIT K SDIV,SDIVN,SDMD,SDOUT,SDSTOP,SDDIV,SDBDT,SDCT,SDDFN,SDDT,SDEDT,SDFIG,SDI,SDLINE,SDMAX,SDMO,SDOE,SDOE0,SDPAGE,SDPNOW,SDXDT,SDXEDT,SDXMO,SDXYR,SDYR,Y,%,SDX,SDFIG1,DTOUT,DUOUT,X,Y D END^SCRPW50 Q
30 ;
31DPRT(SDIV) ;Print division
32 K SDTIT D DHDR^SCRPW46(SDIV,1,.SDTIT) I '$D(^TMP("SCRPW",$J,SDIV)) S SDX="No activity within report parameters found for this division!" D HDR Q:SDOUT W !!?(IOM-$L(SDX)\2),SDX Q
33 S SDDT=SDBDT D FIG,HDR,HD1 Q:SDOUT D LINE(SDDT) F S SDDT=$O(^TMP("SCRPW",$J,SDIV,"YR",SDDT)) Q:'SDDT!SDOUT D LINE(SDDT)
34 D:$Y>($S(IOSL<80:IOSL,1:80)-5) HDR Q:SDOUT F W ! Q:$Y>($S(IOSL<80:IOSL,1:80)-6)
35 W !?25,"Uniques in this report are based on OUTPATIENT ENCOUNTER file records with a"
36 W !?25,"status of '"_$S(SDSTA=2:"",SDSTA=8:"inpatient appointment ",1:"Out/Inpatient ")_"checked out'. This excludes any 'action required' activity."
37 Q
38 ;
39DIV(SDD) ;Check division
40 ;Required input: MEDICAL CENTER DIVISION pointer
41 Q:'SDDIV 1
42 Q $D(SDDIV(SDD))
43 ;
44SET(SDIV) ;Set TMP global
45 S SDSTOP=SDSTOP+1 D:SDSTOP#2000=0 STOP Q:SDOUT
46 Q:'SDIV D SET1(SDIV) D:SDMD SET1(0) Q
47 ;
48SET1(SDIV) S ^TMP("SCRPW",$J,SDIV,"PT",SDDFN,$E(SDDT,1,5)_"00")="" Q
49 ;
50OENC S SDXDT=SDBDT,SDDFN=0
51 F S SDDFN=$O(^SCE("ADFN",SDDFN)) Q:'SDDFN S SDDT=SDXDT F S SDDT=$O(^SCE("ADFN",SDDFN,SDDT)) Q:'SDDT!(SDDT>SDEDT) D OENC1
52 Q
53 ;
54OENC1 S SDOE=0 F S SDOE=$O(^SCE("ADFN",SDDFN,SDDT,SDOE)) Q:'SDOE S SDOE0=$$GETOE^SDOE(SDOE) I $$OE(SDOE0,SDSTA) S SDIV=$P(SDOE0,U,11) I SDIV,$$DIV(SDIV) D SET(SDIV)
55 Q
56 ;
57OE(SDOE0,SDSTA) ;Evaluate (in)outpatient encounter
58 ;Required input: SDOE0=OUTPATIENT ENCOUNTER zeroeth node
59 ; SDSTA=2 -outpatient,8 -inpatient, 2^8 -both
60 ;Output: '1' if checked out "parent" encounter, '0' otherwise
61 I $P(SDOE0,U,4),$P($G(^SC($P(SDOE0,U,4),0)),U,17)="Y" Q 0
62 S SDSTA=$G(SDSTA,2),SDSTA="^"_SDSTA_"^"
63 Q:'$P(SDOE0,U,6)&(SDSTA[$P(SDOE0,U,12))&($P(SDOE0,U,7)'="") 1
64 Q 0
65 ;
66STOP ;Check for stop task request
67 S:$G(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
68 ;
69HDR D STOP Q:SDOUT I $E(IOST)="C" N DIR S DIR(0)="E" D ^DIR S SDOUT=Y'=1 Q:SDOUT
70 W:SDPAGE>1!($E(IOST)="C") $$XY^SCRPW50(IOF,1,0) W:$X $$XY^SCRPW50("",0,0) W SDLINE,!?36,"<*> TREND OF FACILITY UNIQUES BY 12 MONTH DATE RANGES <*>"
71 N SDI S SDI=$S(SDSTA=2:"Checked Out - Outpatients",SDSTA=8:"Checked Out - Inpatients",1:"Checked Out - Out/Inpatients") W !,?53,SDI ;?(132-SDI\2),SDI
72 S SDI=0 F S SDI=$O(SDTIT(SDI)) Q:'SDI W !?(132-$L(SDTIT(SDI))\2),SDTIT(SDI)
73 W !,SDLINE,!,"Date printed: ",SDPNOW,?125,"Page: ",SDPAGE,!,SDLINE S SDPAGE=SDPAGE+1 Q
74 ;
75HD1 Q:SDOUT W !!,"12 mo. date range",?23,"Uniques",?32,"| Histogram (each ""*"" equals ",SDFIG," unique",$S(SDFIG=1:"",1:"s"),")",!,$E(SDLINE,1,SDFIG1) Q
76 ;
77DTINC(SDDT) ;Increment date by one month
78 ;Required input: SDDT=date
79 ;Output: next month to examine
80 Q:$E(SDDT,4,5)=12 $E(SDDT,1,3)+1_"0100"
81 Q $E(SDDT,1,5)+1_"00"
82 ;
83LOOK S ^TMP("SCRPW",$J,SDIV,"YR",SDDT)=0,SDDFN=0 F S SDDFN=$O(^TMP("SCRPW",$J,SDIV,"PT",SDDFN)) Q:'SDDFN D L1
84 Q
85 ;
86L1 I $D(^TMP("SCRPW",$J,SDIV,"PT",SDDFN,SDDT)) D LSET Q
87 S SDX=$O(^TMP("SCRPW",$J,SDIV,"PT",SDDFN,SDDT)) I SDX,SDX<SDXDT D LSET
88 Q
89 ;
90LSET S ^TMP("SCRPW",$J,SDIV,"YR",SDDT)=^TMP("SCRPW",$J,SDIV,"YR",SDDT)+1 Q
91 ;
92YDTINC(SDDT) ;Increment date by one year
93 ;Required input: SDDT=date
94 ;Output: date + 1 year
95 Q $E(SDDT,1,3)+1_$E(SDDT,4,7)
96 ;
97FIG S SDMAX=^TMP("SCRPW",$J,SDIV,"YR","MAX") F SDFIG=1,10,25,50,100,250,500,1000,2500,5000,10000 Q:SDMAX/SDFIG<99
98 S SDFIG1=34+(SDMAX\SDFIG) S:SDFIG1<73 SDFIG1=73 Q
99 ;
100LINE(SDDT) ;Print statistics line
101 ;Required input: SDDT=date
102 D:$Y>(IOSL-3) HDR,HD1 Q:SDOUT S SDCT=^TMP("SCRPW",$J,SDIV,"YR",SDDT),SDMO=$E(SDDT,4,5),SDYR=(17+$E(SDDT))_$E(SDDT,2,3),SDXMO=SDMO-1 S:SDXMO=0 SDXMO=12 S:$L(SDXMO)=1 SDXMO=0_SDXMO
103 S SDXYR=$S(SDXMO=12:SDYR,1:SDYR+1)
104 W !,SDMO,"/",SDYR," thru ",SDXMO,"/",SDXYR,?24,$J(SDCT,6,0),?32,"| " F SDI=1:1:(SDCT\SDFIG) W "*"
105 Q
Note: See TracBrowser for help on using the repository browser.