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

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

initial load of WorldVistAEHR

File size: 2.6 KB
Line 
1IMRSCNT1 ;ISC-SF/JLI-LOCAL COUNT OF PTS, STATUS, OP VISITS, IP STAYS, ETC. CONTINUED (PRINT) ;9/26/91 13:00
2 ;;2.1;IMMUNOLOGY CASE REGISTRY;;Feb 09, 1998
3 S IMRUT=0 D OPPRNT I 'IMRUT D IPPRNT
4 Q
5 ;
6OPPRNT ;
7 S IMRD="FOR THE PERIOD "_$E(IMRSD,4,5)_"/"_$E(IMRSD,6,7)_"/"_$E(IMRSD,2,3)_" TO "_$E(IMRED,4,5)_"/"_$E(IMRED,6,7)_"/"_$E(IMRED,2,3)
8 Q:'$D(^TMP($J,"CT","SO")) S IMRX="SPECIFIC OUTPATIENT ACTIVITY"
9 S IMRUT=0,I="" F IMRI1=0:0 Q:IMRUT S I=$O(^TMP($J,"SOP",I)) Q:I="" I $D(^TMP($J,"CT","SO",I)) S IMRN=^(I),IMRSC=+$O(^DIC(40.7,"C",I,0)),IMRSC=$S($D(^DIC(40.7,IMRSC,0)):$P(^(0),U,1,2),1:"NO ID^"),IMRV=^TMP($J,"CT","SV",I) D SC
10 Q
11SC S N=0,A="" F J=0:0 S A=$O(^TMP($J,"CT","SO",I,A)) Q:A="" F K=0:0 S K=$O(^TMP($J,"CT","SO",I,A,K)) Q:K'>0 S N=N+1
12 D HEDR Q:IMRUT S X1=$J($P(IMRSC,U,2),4)_" "_$E($P(IMRSC,U),1,25) W !,X1,?32,$J(N,4)," patient",$S(N'=1:"s",1:" ")," ",$J(IMRV,7,2)," visit",$S(IMRV'=1:"s",1:" ")," ",$J(IMRN,4)," stop",$S(IMRN'=1:"s",1:""),!
13 S A=""
14 F J=0:0 S A=$O(^TMP($J,"CT","SO",I,A)) Q:A="" F N=0:0 S N=$O(^TMP($J,"CT","SO",I,A,N)) Q:N'>0 S IMRN=^(N),IMRV=^TMP($J,"CT","SV",I,N) S DFN=N D NS^IMRCALL K DFN D SC2
15 Q
16SC2 ;
17 S L=$S($Y+4>IOSL:1,1:0) D:L HEDR Q:IMRUT W:L !,X1," (Continued)",! W !?5,A,?32,IMRSSN,?44,$J(IMRV,7,2)," visit",$S(IMRV'=1:"s",1:" ")," ",$J(IMRN,4)," stop",$S(IMRN'=1:"s",1:"")
18 Q
19 ;
20IPPRNT ;
21B Q:'$D(^TMP($J,"CT","BS")) S IMRX="SPECIFIC INPATIENT ACTIVITY",IMRUT=0
22 S I="" F IMRII=0:0 Q:IMRUT S I=$O(^TMP($J,"SBS",I)) Q:I="" I $D(^TMP($J,"CT","BS",I)) D BS
23 Q
24BS S N=0,N1=0,ND=0,A=""
25 F J=0:0 S A=$O(^TMP($J,"CT","BS",I,A)) Q:A="" S IMRSS="" F IMRSSI=0:0 S IMRSS=$O(^TMP($J,"CT","BS",I,A,IMRSS)) Q:IMRSS="" S N=N+1,ND=ND+^(IMRSS) F K=0:0 S K=$O(^TMP($J,"CT","BS",I,A,IMRSS,K)) Q:K'>0 S N1=N1+1
26 D HEDR Q:IMRUT S X1=I W !,X1,?32,$J(N,4)," patient",$S(N'=1:"s",1:" ")," ",$J(N1,4)," stay",$S(N1'=1:"s",1:" ")," ",$J(ND,6)," day",$S(ND'=1:"s",1:""),!
27 S A=""
28 F J=0:0 S A=$O(^TMP($J,"CT","BS",I,A)) Q:A=""!IMRUT S IMRSS="" F IMRSSI=0:0 Q:IMRUT S IMRSS=$O(^TMP($J,"CT","BS",I,A,IMRSS)) Q:IMRSS="" D BS0
29 Q
30BS0 ;
31 F N=0:0 S N=$O(^TMP($J,"CT","BS",I,A,IMRSS,N)) Q:N'>0 S N1=^(N) S L=$S($Y+4>IOSL:1,1:0) D:L HEDR Q:IMRUT D BS1
32 Q
33BS1 ;
34 W:L !,X1," (Continued)",! W !?5,A,?32,IMRSS,?50,$E(N,4,5),"/",$E(N,6,7),"/",$E(N,2,3),?67,$J(N1,4)," day",$S(N1'=1:"s",1:"")
35 Q
36 ;
37HEDR ;
38 S IMRUT=0 I IOST["C-",IMRPG R !!?15,"Enter RETURN to continue or '^' to exit: ",X:DTIME S:'$T IMRUT=1 I 'IMRUT,X[U S IMRUT=1
39 I 'IMRUT W:$Y>0 @IOF W:IOST'["C-" !!! W !,?(IOM-$L(IMRX)\2),IMRX,!?(IOM-$L(IMRD)\2),IMRD,!?(IOM-$L(IMRDTE)\2),IMRDTE,!! S IMRPG=IMRPG+1
40 Q
Note: See TracBrowser for help on using the repository browser.