Changeset 623 for WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPW6.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPW6.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPW6.m
r613 r623 1 SCRPW6 2 ;;5.3;Scheduling;**139,144,466,510**;AUG 13, 1993;Build 3 3 4 5 6 7 8 QUE 9 N ZTSAVE F X="SDDIV","SDDIV(","SDDNU(","SDSTA"S ZTSAVE(X)=""10 11 UNIQ 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 EXIT 30 31 DPRT(SDIV) 32 33 34 35 36 37 38 39 DIV(SDD) 40 41 42 43 44 SET(SDIV) 45 46 47 48 SET1(SDIV) 49 50 OENC 51 52 53 54 OENC1 55 56 57 OE(SDOE0,SDSTA) 58 59 60 61 62 63 64 65 66 STOP 67 68 69 HDR 70 71 72 73 74 75 HD1 76 77 DTINC(SDDT) 78 79 80 81 82 83 LOOK 84 85 86 L1 87 88 89 90 LSET 91 92 YDTINC(SDDT) 93 94 95 96 97 FIG 98 99 100 LINE(SDDT) 101 102 103 104 105 1 SCRPW6 ;RENO/KEITH - Trend of Facility Uniques by 12 Month Date Ranges ; 15 Jul 98 02:38PM 2 ;;5.3;Scheduling;**139,144,466**;AUG 13, 1993;Build 2 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") 8 QUE 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 11 UNIQ ;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 ; 29 EXIT 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 ; 31 DPRT(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 ; 39 DIV(SDD) ;Check division 40 ;Required input: MEDICAL CENTER DIVISION pointer 41 Q:'SDDIV 1 42 Q $D(SDDIV(SDD)) 43 ; 44 SET(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 ; 48 SET1(SDIV) S ^TMP("SCRPW",$J,SDIV,"PT",SDDFN,$E(SDDT,1,5)_"00")="" Q 49 ; 50 OENC 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 ; 54 OENC1 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 ; 57 OE(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 ; 66 STOP ;Check for stop task request 67 S:$G(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q 68 ; 69 HDR 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 ; 75 HD1 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 ; 77 DTINC(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 ; 83 LOOK 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 ; 86 L1 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 ; 90 LSET S ^TMP("SCRPW",$J,SDIV,"YR",SDDT)=^TMP("SCRPW",$J,SDIV,"YR",SDDT)+1 Q 91 ; 92 YDTINC(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 ; 97 FIG 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 ; 100 LINE(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 TracChangeset
for help on using the changeset viewer.
