LRACSUM ;SLC/DCM - INDIVIDUAL PATIENT SUMMARY. ;4/17/91  14:30 ;
 ;;5.2;LAB SERVICE;**27,201**;Sep 27, 1994
DFN S LRIN=0,LRIDT=0,LREND=0,LROUT=9999999,LRDIS=0 K ZTRTN,DIC,X2 D ^LRDPA Q:Y<0  D QUE G:POP END I $D(ZTSK) K ZTSK Q
 U IO D LRLLOC,END Q
QUE S %ZIS="QM" D ^%ZIS Q:POP  I $D(IO("Q")) K IO("Q") S:'$D(ZTRTN) ZTRTN="LRLLOC^LRACSUM" S ZTDESC="Patient lab summary" F I="%*","AGE","D*","LR*","PNM","SEX","SSN","U" S ZTSAVE(I)=""
 I  D ^%ZTLOAD S:'$D(ZTSK) POP=1 W !,"PRINT",$S('POP:"",1:" NOT")," QUEUED",! K ZTRTN,ZTIO,ZTDESC,ZTSAVE,LRBOT,LRNM,LRIDT,LROUT,LRDIS,LRCDT,LRTNN,LRDFN Q
 Q
LRLLOC S:$D(ZTQUEUED) ZTREQ="@"
 D SET S LRLLOC=$S($L(LRWRD):LRWRD,$D(^LR(LRDFN,.1)):^(.1),1:"File Room")
 S SSN=" "_SSN_" "
 S ^TMP($J,LRDFN,0)=PNM_U_SSN_U_AGE_U_LRDPF_U_DFN
 S ^TMP($J,LRDFN,"MISC")="MISCELLANEOUS TESTS^" D LRIDT^LRACSUM1
 D ^LRACSUM3,MICRO^LRACSUM1 Q
END D END^LRACM,^%ZISC
 Q
SET S LRBOT=$P(^LAB(64.5,1,0),U,2),LRTD=$P(^(1,0),U,3),LRNM=0
 K ^TMP($J),DIC D DT^LRX S LRCDT=LRDT0
 D LRCALE^LRACSUM1 S LRTNN=2,LRDPF=+$P(^LR(LRDFN,0),U,2) D PT^LRX
 Q
DIS U IO S LRFD=LRF-.5,LRLTR="FILE" D ^LRLTR F II=0:0 S LRFD=$O(^DGPM("AMV3",LRFD)) Q:LRFD<1!(LRFD>LRL)  S LRFN=0 D FN ;MAS
 Q
FN F JJ=0:0 S LRFN=$O(^DGPM("AMV3",LRFD,LRFN)) Q:LRFN<1  S LRINN=0 F K=0:0 S LRINN=$O(^DGPM("AMV3",LRFD,LRFN,LRINN)) Q:LRINN<1  D WORK ;MAS
 Q
WORK Q:'$D(^DGPM(LRINN,0))!('$P(^(0),"^",14))  S X=^(0),LROUT=9999999-$P(^DGPM($P(X,"^",14),0),"^"),(LRIDT,LRIN)=9999999-$P(X,"^") ;MAS
 Q:'$D(^DPT(LRFN,"LR"))  S LRDFN=^("LR"),DFN=LRFN D PT^LRX D LRLLOC
 Q
MANUAL S LREND=0,LRDIS=1 K DIC W !!,"Print Discharge Summaries for (1) Single patient -or- (2) All patients: 1// " R LRX:DTIME S:LRX="" LRX=1 Q:LRX["^"  G:"12"'[LRX MANUAL
 I LRX=1 D ^LRDPA Q:LRDFN<1  D LIST Q:X="^"  D:'$D(LREDT) ^LRWU3 Q:LREND  S (LRIDT,LRIN)=9999999-LRSDT,LROUT=9999999-LREDT
 I $D(LRX),LRX=2 D ^LRWU3 Q:LREND  S LRF=$P(LREDT,".",1),LRL=LRSDT K LREDT,LRSDT S ZTRTN="DIS^LRACSUM" D QUE K ZTRTN G:POP END G OUT
 K LREDT,LRSDT D QUE G:POP END I $D(ZTSK) K ZTSK Q
 U IO D LRLLOC,END
 Q
DQ S LRDIS=1,X="T-1",%DT="" D ^%DT S LRF=+Y,LRL=+Y_.5
 D DIS G END
LIST I '$D(^DGPM("C",DFN)) W !!,"No In-patient stays for this patient" Q  ;MAS
 S:'$D(IOM) IOM=80 W !!?10,"ADMISSION DATE",?35,"DISCHARGE DATE" D DASH^LRX
 S L=0,LRI=0
 F M=0:0 S L=$O(^DGPM("ATID1",DFN,L)) Q:L<1  D A ;MAS
 W !!,"Select EPISODE OF CARE: None// " R X:DTIME K LREDT Q:X["^"!(X="")  G:X="?" LIST Q:'$D(LRI(X))  S LREDT=$P($P(LRI(X),U,1),U,1),LRSDT=$P($P(LRI(X),U,2),U,1)_.5
 Q
OUT I $D(ZTSK) K ZTSK Q
 D DIS,END Q
A S Y="",X=$O(^DGPM("ATID1",DFN,L,0)) I X,$D(^DGPM(X,0)),$P(^(0),"^",2)=1 S Z=$P(^(0),"^",17),Y=9999999.9999999-L,LRI=LRI+1,LRI(LRI)=Y Q:'Y  S Y=$$Y2K^LRX(Y) W !?4,LRI,".   ",?10,Y
 Q:'$G(Z)  I $D(^DGPM(Z,0)) S Y=$P(^(0),"^"),LRI(LRI)=LRI(LRI)_U_Y S:Y Y=$$Y2K^LRX(Y) W ?35,Y
 Q