| [613] | 1 | IMRLLAB1 ;ISC-SF.SEA/JLI-LOCAL LISTING OF LAB UTILIZATION (PRINT) ;9/2/97  10:11
 | 
|---|
 | 2 |  ;;2.1;IMMUNOLOGY CASE REGISTRY;;Feb 09, 1998
 | 
|---|
 | 3 | LABPRNT ;
 | 
|---|
 | 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
 | 
|---|
 | 7 | LABPRN ;
 | 
|---|
 | 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
 | 
|---|
 | 28 | LABPRN2 ;
 | 
|---|
 | 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
 | 
|---|
 | 34 | LABPRN1 ;
 | 
|---|
 | 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
 | 
|---|
 | 37 | PRNT1 ;
 | 
|---|
 | 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 |  ;
 | 
|---|
 | 41 | PRTC ; 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
 | 
|---|
 | 45 | HEDR ;
 | 
|---|
 | 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
 | 
|---|
 | 48 | HEDR2 ;
 | 
|---|
 | 49 |  W !,?37,"# OF",?48,"# OF",?60,"# OF DIFFERENT",!,"NAME",?25,"SSN",?36,"ORDERS",?47,"RESULTS",?63,"LAB TESTS",!
 | 
|---|
 | 50 |  Q
 | 
|---|
 | 51 | HEDR1 Q:IMRUT
 | 
|---|
 | 52 |  W !?30,"# Results",?55,"Max # Results",!?30,"Reported",?44,"Patients",?55,"Per Patient (# patients)",!
 | 
|---|
 | 53 |  Q
 | 
|---|