source: WorldVistAEHR/trunk/r/ICR_IMMUNOLOGY_CASE_REGISTRY-IMR/IMRLCNT3.m

Last change on this file was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.5 KB
Line 
1IMRLCNT3 ;ISC-SF/JLI-LOCAL COUNT OF PTS, STATUS, OP VISITS, IP STAYS, ETC. CONTINUED (PRINT) ;9/2/97 13:23
2 ;;2.1;IMMUNOLOGY CASE REGISTRY;;Feb 09, 1998
3IPPRNT ;
4 D GETNOW^IMRACESS
5 Q:'$D(^TMP($J,IMR1C,"IP"))
6 D PRTC^IMRLCNT2 Q:IMRUT
7 S IMRX="SELECTED INPATIENT ACTIVITY" D HEDR
8 W !!,"Totals: " S X=^TMP($J,IMR1C,"IP"),Y=^("IP","ADMITS"),Z=^("DAYS") W X," patients for ",Y," stays and ",Z," days of inpatient care",!
9 S IMRALOS=Z/Y ;average length of stay
10 F I=0:0 S I=$O(^TMP($J,IMR1C,"IP","N",I)) Q:I'>0!(IMRUT) D
11 .I ($Y+4>IOSL) D PRTC^IMRLCNT2 Q:IMRUT W @IOF
12 .W !?10,$J(I,3)," stay",$S(I>1:"s",1:" ")," ",$S(^TMP($J,IMR1C,"IP","N",I)>1:"each",1:" ")," for ",$J(^TMP($J,IMR1C,"IP","N",I),4)," patient",$S(^TMP($J,IMR1C,"IP","N",I)>1:"s",1:"")
13 .Q
14 Q:IMRUT
15 S Z=0,X="",Y=^TMP($J,IMR1C,"IP","ADMITS"),Z1=Y#2,Y=Y\2,Y=$S(Z1:Y+1,1:Y)
16 F I=-1:0 S I=$O(^TMP($J,IMR1C,"IP",I)) Q:+I'=I S Z=Z+^(I) I Z'<Y S X=$S(X="":I,1:(X+I)\2) Q:Z1 Q:Z>Y
17 W !!?10,"Median Length of Stay (MLOS): ",$J(X,4,1)," days."
18 W !!?9,"Average Length of Stay (ALOS): ",$J(IMRALOS,4,1)," days."
19 W ! S IMRBS=""
20 F I=0:0 S IMRBS=$O(^TMP($J,IMR1C,"IP","BS",IMRBS)) Q:IMRBS=""!(IMRUT) D
21 .S X=^(IMRBS),Y=^(IMRBS,"STAYS"),Z=^("DAYS")
22 .I ($Y+4>IOSL) D PRTC^IMRLCNT2 Q:IMRUT W @IOF
23 .W !,$E(IMRBS,1,18),?20,$J(X,4)," patient",$S(X>1:"s, ",1:", "),$J(Y,4)," stay",$S(Y>1:"s, ",1:", "),"and ",$J(Z,5)," days"
24 .D IPPR1
25 .Q
26 Q:IMRUT
27 I $D(^XUSEC("IMRMGR",DUZ)),$D(^TMP($J,IMR1C,"NO BS")) D Q:IMRUT D PRTC^IMRLCNT2
28 .D PRTC^IMRLCNT2 Q:IMRUT D HEDR
29 .W !!,"OCCURRENCES OF NO BEDSECTION ID",!!
30 .F IMRDFN=0:0 S IMRDFN=$O(^TMP($J,IMR1C,"NO BS",IMRDFN)) Q:IMRDFN'>0!(IMRUT) D IPPR0
31 .Q
32 Q:IMRUT
33TOPN ;I '$D(ZTQUEUED) S IMRRMAX=0 D:$D(^XUSEC("IMRMGR",DUZ)) ASKQ^IMRLCNT1
34 Q:IMRUT!(IMRRMAX'>0) K ^TMP($J,IMR1C,"OV"),^("IPST"),^("IPDA")
35 F I=0:0 S I=$O(^TMP($J,IMR1C,"PAT",I)) Q:I'>0 I $D(^(I,"S")) S X=^("S"),Y=0 D OP1 S ^TMP($J,IMR1C,"OV",(99999-X),I)=X_U_Y_U_Z
36 F I=0:0 S I=$O(^TMP($J,IMR1C,"PAT",I)) Q:I'>0 I $D(^(I,"IP")) S X=^("IP"),Y=^("IP","DAYS") S ^TMP($J,IMR1C,"IPST",(9999-X),I)=X_U_Y,^TMP($J,IMR1C,"IPDA",(9999-Y),I)=X_U_Y
37 I $D(^TMP($J,IMR1C,"OV")) S IMRX="HIGHEST UTILIZATION OF VISITS" D HEDR,HEDRA S IMRN=0
38 F I=0:0 Q:IMRN'<IMRRMAX!(IMRUT) S I=$O(^TMP($J,IMR1C,"OV",I)) Q:I'>0!(IMRUT) F J=0:0 S J=$O(^TMP($J,IMR1C,"OV",I,J)) Q:J'>0!(IMRUT) D
39 .S IMRN=IMRN+1,X=^TMP($J,IMR1C,"OV",I,J),DFN=J D NS^IMRCALL
40 .I ($Y+4>IOSL) D PRTC^IMRLCNT2 Q:IMRUT D HEDR,HEDRA
41 .W !,IMRNAM,?32,IMRSSN,?45,$J(+X,8),?55,$J($P(X,U,3),8),?60,$J($P(X,U,2),10)
42 .Q
43 Q:IMRUT
44 I $D(^TMP($J,IMR1C,"IPST")) S IMRX="HIGHEST NUMBER OF STAYS" D HEDR,HEDRB S IMRN=0
45 F I=0:0 Q:IMRN'<IMRRMAX!(IMRUT) S I=$O(^TMP($J,IMR1C,"IPST",I)) Q:I'>0!(IMRUT) F J=0:0 S J=$O(^TMP($J,IMR1C,"IPST",I,J)) Q:J'>0!(IMRUT) D
46 .S IMRN=IMRN+1,X=^TMP($J,IMR1C,"IPST",I,J),DFN=J D NS^IMRCALL
47 .I ($Y+4>IOSL) D PRTC^IMRLCNT2 Q:IMRUT D HEDR,HEDRB
48 .W !,IMRNAM,?32,IMRSSN,?45,$J(+X,8),?60,$J($P(X,U,2),10)
49 .Q
50 Q:IMRUT
51 D PRTC^IMRLCNT2 Q:IMRUT W @IOF
52 I $D(^TMP($J,IMR1C,"IPDA")) S IMRX="HIGHEST NUMBER OF DAYS" D HEDR,HEDRB S IMRN=0
53 F I=0:0 Q:IMRN'<IMRRMAX!(IMRUT) S I=$O(^TMP($J,IMR1C,"IPDA",I)) Q:I'>0!(IMRUT) F J=0:0 S J=$O(^TMP($J,IMR1C,"IPDA",I,J)) Q:J'>0!(IMRUT) D
54 .S IMRN=IMRN+1,X=^TMP($J,IMR1C,"IPDA",I,J),DFN=J D NS^IMRCALL
55 .I ($Y+4>IOSL) D PRTC^IMRLCNT2 Q:IMRUT D HEDR,HEDRB
56 .W !,IMRNAM,?32,IMRSSN,?45,$J(+X,8),?60,$J($P(X,U,2),10) K DFN
57 .Q
58 Q:IMRUT D PRTC^IMRLCNT2 W @IOF
59 Q
60IPPR0 ;
61 F IMRD1=0:0 S IMRD1=$O(^TMP($J,IMR1C,"NO BS",IMRDFN,IMRD1)) Q:IMRD1'>0!(IMRUT) D
62 .I ($Y+4>IOSL) D PRTC^IMRLCNT2 Q:IMRUT D HEDR W !!,"OCCURRENCES OF NO BEDSECTION ID",!!
63 .D IPPR2
64 .Q
65 Q
66 ;
67OP1 F J=0:0 S J=$O(^TMP($J,IMR1C,"PAT",I,"OP",J)) Q:J'>0 S Y=Y+1
68 S Z=0 F J=0:0 S J=$O(^TMP($J,IMR1C,"PAT",I,"S",J)) Q:J'>0 S Z=Z+^(J)
69 Q
70 ;
71IPPR1 S X="",Z=0,Z1=Y#2,Y=Y\2,Y=$S(Z1:Y+1,1:Y) F J=-1:0 S J=$O(^TMP($J,IMR1C,"IP","BS",IMRBS,J)) Q:+J'=J S Z=Z+^(J) I Z'<Y S X=$S(X="":J,1:(X+J)/2) Q:Z1 Q:Z>Y
72 W " MLOS:",$J(X,6,1)," days"
73 Q
74IPPR2 S IMRI=$O(^TMP($J,IMR1C,"NO BS",IMRDFN,IMRD1,0)),DFN=IMRDFN D NS^IMRCALL
75 W !,$E(IMRNAM,1,25),?27,IMRSSN," moved in: ",$E(IMRD1,4,5),"/",$E(IMRD1,6,7),"/",$E(IMRD1,2,3)," PTF entry: ",IMRI
76 K DFN,VA,VADM
77 Q
78 ;
79HEDR ;
80 S IMRZ="INPATIENT AND OUTPATIENT ACTIVITY"
81 W:$Y>0 @IOF W:IOST'["C-" !!! W !,?(IOM-$L(IMRZ)\2),IMRZ,!,?(IOM-$L(IMRX)\2),IMRX,!?(IOM-$L(IMRD)\2),IMRD,!?(IOM-$L(IMRLBL)\2),IMRLBL,!?(IOM-$L(IMRDTE)\2),IMRDTE,!! S IMRPG=IMRPG+1
82 Q
83 ;
84HEDRA W ?69,"DIFFERENT",!,"PATIENT NAME",?35,"SSN",?48,"VISITS",?60,"STOPS",?68,"STOP CODES",!
85 Q
86 ;
87HEDRB W "PATIENT NAME",?35,"SSN",?48,"# STAYS",?66,"# DAYS",!
88 Q
89 ;
Note: See TracBrowser for help on using the repository browser.