source: WorldVistAEHR/trunk/r/ICR_IMMUNOLOGY_CASE_REGISTRY-IMR/IMRLLAB1.m@ 619

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

initial load of WorldVistAEHR

File size: 2.6 KB
Line 
1IMRLLAB1 ;ISC-SF.SEA/JLI-LOCAL LISTING OF LAB UTILIZATION (PRINT) ;9/2/97 10:11
2 ;;2.1;IMMUNOLOGY CASE REGISTRY;;Feb 09, 1998
3LABPRNT ;
4 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),IMRUT=0
5 F IMR0C=0:1:4,"T" Q:IMRUT S IMRLBL=$S(+IMR0C=IMR0C:$P("NO CATEGORY DEFINED^HIV+^HIV+ (CD4<500)^AIDS-3^AIDS","^",IMR0C+1),1:"TOTAL HIV+ (ALL CATEGORIES) POPULATION"),IMR1C="C"_IMR0C I IMR2C!(IMR0C="T") D LABPRN
6 Q
7LABPRN ;
8 Q:'$D(^TMP($J,IMR1C,"A")) S IMRX="LABORATORY UTILIZATION DATA" D HEDR Q:IMRUT
9 S Z1=0 F I=0:0 S I=$O(^TMP($J,IMR1C,"PAT",I)) Q:I'>0 S Z1=Z1+^(I)
10 S Z=0 F I=0:0 S I=$O(^TMP($J,IMR1C,"A",I)) Q:+I'=I S J="" F K=0:0 S J=$O(^TMP($J,IMR1C,"A",I,J)) Q:J="" S Z=Z+1
11 W !,"Totals: " S X=^TMP($J,IMR1C,"LR"),Y=^("LR","TST") W Z1," orders placed (",Y," results reported)",!?15," during this period for ",X," patients",!!,?10,"These include ",Z," different entries from LAB TEST file",!
12 F I=0:0 S I=$O(^TMP($J,IMR1C,"LR","N",I)) W:I'>0 ! Q:I'>0!(IMRUT) D
13 .I ($Y+3>IOSL) D PRTC Q:IMRUT D HEDR
14 .D LABPRN1
15 .Q
16 Q:IMRUT
17 D HEDR1
18 F I=0:0 Q:IMRUT S I=$O(^TMP($J,IMR1C,"A",I)) Q:+I'=I!(IMRUT) S N="" F J=0:0 S N=$O(^TMP($J,IMR1C,"A",I,N)) Q:N=""!(IMRUT) D
19 .I ($Y+3>IOSL) D PRTC Q:IMRUT D HEDR,HEDR1
20 .D PRNT1
21 .Q
22 Q:IMRUT
23 S IMRJ=0 I IMRRMAX D PRTC Q:IMRUT D HEDR,HEDR2
24 F IMRI=0:0 Q:IMRUT!(IMRJ'<IMRRMAX) S IMRI=$O(^TMP($J,IMR1C,"MAX",IMRI)) Q:+IMRI'=IMRI!(IMRUT) D LABPRN2
25 D PRTC
26 K IMRI,IMRJ,IMRXX,DFN,VA,VADM,VAERR
27 Q
28LABPRN2 ;
29 F DFN=0:0 S DFN=$O(^TMP($J,IMR1C,"MAX",IMRI,DFN)) Q:DFN'>0!(IMRUT) S IMRJ=IMRJ+1,IMRXX=^(DFN) D DEM^VADPT D
30 .I ($Y+3)>IOSL D PRTC Q:IMRUT D HEDR,HEDR2
31 .W !,$E(VADM(1),1,20),?23,VA("PID"),?35,$J(+IMRXX,7),?45,$J($P(IMRXX,U,2),9),?61,$J($P(IMRXX,U,3),9)
32 .Q
33 Q
34LABPRN1 ;
35 S X=+^TMP($J,IMR1C,"LR","N",I),Y=$P(^(I),U,2) W !?8,$J(Y,7)," order",$S(Y'=1:"s",1:" ")," placed for ",$J(X,5)," patient",$S(X>1:"s",1:"") I Y=0 W " in file, not included above"
36 Q
37PRNT1 ;
38 S X=+^TMP($J,IMR1C,"A",I,N),Y=$P(^(N),U,2) Q:Y<IMRN1 W !,N,?30,$J(Y,7)," ",$J(X,6) I X'=Y&(X'=1) W ?55,$J(+^(N,"MAX"),7)," (",$P(^("MAX"),U,2)," pat)"
39 Q
40 ;
41PRTC ; press return to continue
42 Q:$E(IOST)'="C"!(IMRUT)!($D(IO("S")))
43 K DIR S DIR(0)="E" D ^DIR K DIR S:$D(DIRUT)!(Y=0) IMRUT=1
44 Q
45HEDR ;
46 W:$Y>0 @IOF W:IOST'["C" !!! W !,?(IOM-$L(IMRX)\2),IMRX,!?(IOM-$L(IMRD)\2),IMRD,!?(IOM-$L(IMRLBL)\2),IMRLBL,!?(IOM-$L(IMRDTE)\2),IMRDTE,!
47 Q
48HEDR2 ;
49 W !,?37,"# OF",?48,"# OF",?60,"# OF DIFFERENT",!,"NAME",?25,"SSN",?36,"ORDERS",?47,"RESULTS",?63,"LAB TESTS",!
50 Q
51HEDR1 Q:IMRUT
52 W !?30,"# Results",?55,"Max # Results",!?30,"Reported",?44,"Patients",?55,"Per Patient (# patients)",!
53 Q
Note: See TracBrowser for help on using the repository browser.