source: qrda/C0Q/trunk/p/C0QERTIM.m@ 1751

Last change on this file since 1751 was 1501, checked in by Sam Habiel, 12 years ago

Latest routines; T11 copy

File size: 2.4 KB
Line 
1C0QERTIM ; Time from admission to leaving a hospital location ; 5/23/12 2:26pm
2 ;;1.0;C0Q;;May 21, 2012;Build 63
3EN ;Get Location
4 S DIC=42,DIC(0)="AEMQ" D ^DIC I Y<1 G EXIT
5 S LOCATION=+Y
6 ;Start date
7 S %DT="AE",%DT("A")="Start DATE: " D ^%DT G:Y=-1 EXIT S START=Y
8 ;End date
9 S %DT="AE",%DT("A")="Stop DATE: " D ^%DT G:Y=-1 EXIT S STOP=Y
10 ;select device:
11 S %ZIS="Q" D ^%ZIS G EXIT:POP
12 I $D(IO("Q")) D G EXIT
13 . S ZTRTN="DQ^C0QERTIM",ZTDESC="Time from admission to leaving a hospital location"
14 . S ZTSAVE("LOCATION")="",ZTSAVE("START")="",ZTSAVE("STOP")=""
15 . D ^%ZTLOAD D HOME^%ZIS K IO("Q")
16 . Q
17DQ ; Get down to business
18 ;sort on admit date/time in file 45, screen on LOSING WARD in sub-file 535.
19 ;^DGPT("AF",date/time,DA)
20 S PATCOUNT=0,ADMITIME=START
21 F S ADMITIME=$O(^DGPT("AF",ADMITIME)) Q:ADMITIME'>0 D
22 . Q:ADMITIME>STOP
23 . ;FMIN from ADMISSION DATE piece 2
24 . S X=ADMITIME D H^%DTC S FMINDAY=%H,FMINSEC=%T
25 . S D0="" F S D0=$O(^DGPT("AF",ADMITIME,D0)) Q:D0'>0 D
26 . . S D1=0 F S D1=$O(^DGPT(D0,535,D1)) Q:D1'>0 D
27 . . . ;Losing ward in piece 6 of ^DGPT(D0,535,D1,0)
28 . . . Q:$P($G(^DGPT(D0,535,D1,0)),U,6)'=LOCATION
29 . . . ;FMOUT from MOVEMENT DATE on leaving in piece 10
30 . . . S X=$P($G(^DGPT(D0,535,D1,0)),U,10) D H^%DTC S FMOUTDAY=%H,FMOUTSEC=%T
31 . . . I FMINDAY=FMOUTDAY S MINUTES=$P((FMOUTSEC-FMINSEC)/60,".")
32 . . . I FMINDAY'=FMOUTDAY D
33 . . . . S DIFFDAY=FMOUTDAY-FMINDAY
34 . . . . S MINUTES=1440*(DIFFDAY-1)+$P((FMOUTSEC+86400-FMINSEC)/60,".")
35 . . . . Q
36 . . . S PATCOUNT=PATCOUNT+1
37 . . . S ^TMP($J,"PATIENTS",$P(^DPT(+^DGPT(D0,0),0),U))=MINUTES
38 . . . S ^TMP($J,"MINUTES",MINUTES)=1+$G(^TMP($J,"MINUTES",MINUTES))
39 . . . Q
40 . . Q
41 . Q
42 U IO W @IOF
43 ;list median time from Admission to leaving hospital LOCATION
44 S MID=$P(PATCOUNT/2,"."),SUM=0
45 S MEDIAN=0 F S MEDIAN=$O(^TMP($J,"MINUTES",MEDIAN)) Q:MEDIAN'>0 D
46 . S SUM=SUM+^TMP($J,"MINUTES",MEDIAN) Q:SUM>MID
47 . Q
48 W "The median time spent in ",$P(^DIC(42,LOCATION,0),U)," is ",MEDIAN," minutes.",!
49 W !,"Patient",?40,"Minutes in ",$P(^DIC(42,LOCATION,0),U)
50 ;list patient and time from admission to leaving the location
51 S PATIENT="" F S PATIENT=$O(^TMP($J,"PATIENTS",PATIENT)) Q:PATIENT="" D
52 . W !,PATIENT,?40," ",^TMP($J,"PATIENTS",PATIENT)
53EXIT ; DO CLEANUP
54 S:$D(ZTQUEUED) ZTREQ="@"
55 K DIC,START,STOP,LOCATION,PATCOUNT,ADMITIME,FMINDAY,FMINSEC,FMOUTDAY,FMOUTSEC
56 K POP,D0,D1,DIFFDAY,MINUTES,MID,MEDIAN,PATIENT,^TMP($J)
57 Q
Note: See TracBrowser for help on using the repository browser.