| 1 | LRACSUM ;SLC/DCM - INDIVIDUAL PATIENT SUMMARY. ;4/17/91 14:30 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;**27,201**;Sep 27, 1994
|
|---|
| 3 | 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
|
|---|
| 4 | U IO D LRLLOC,END Q
|
|---|
| 5 | 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)=""
|
|---|
| 6 | 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
|
|---|
| 7 | Q
|
|---|
| 8 | LRLLOC S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 9 | D SET S LRLLOC=$S($L(LRWRD):LRWRD,$D(^LR(LRDFN,.1)):^(.1),1:"File Room")
|
|---|
| 10 | S SSN=" "_SSN_" "
|
|---|
| 11 | S ^TMP($J,LRDFN,0)=PNM_U_SSN_U_AGE_U_LRDPF_U_DFN
|
|---|
| 12 | S ^TMP($J,LRDFN,"MISC")="MISCELLANEOUS TESTS^" D LRIDT^LRACSUM1
|
|---|
| 13 | D ^LRACSUM3,MICRO^LRACSUM1 Q
|
|---|
| 14 | END D END^LRACM,^%ZISC
|
|---|
| 15 | Q
|
|---|
| 16 | SET S LRBOT=$P(^LAB(64.5,1,0),U,2),LRTD=$P(^(1,0),U,3),LRNM=0
|
|---|
| 17 | K ^TMP($J),DIC D DT^LRX S LRCDT=LRDT0
|
|---|
| 18 | D LRCALE^LRACSUM1 S LRTNN=2,LRDPF=+$P(^LR(LRDFN,0),U,2) D PT^LRX
|
|---|
| 19 | Q
|
|---|
| 20 | 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
|
|---|
| 21 | Q
|
|---|
| 22 | 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
|
|---|
| 23 | Q
|
|---|
| 24 | 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
|
|---|
| 25 | Q:'$D(^DPT(LRFN,"LR")) S LRDFN=^("LR"),DFN=LRFN D PT^LRX D LRLLOC
|
|---|
| 26 | Q
|
|---|
| 27 | 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
|
|---|
| 28 | 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
|
|---|
| 29 | 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
|
|---|
| 30 | K LREDT,LRSDT D QUE G:POP END I $D(ZTSK) K ZTSK Q
|
|---|
| 31 | U IO D LRLLOC,END
|
|---|
| 32 | Q
|
|---|
| 33 | DQ S LRDIS=1,X="T-1",%DT="" D ^%DT S LRF=+Y,LRL=+Y_.5
|
|---|
| 34 | D DIS G END
|
|---|
| 35 | LIST I '$D(^DGPM("C",DFN)) W !!,"No In-patient stays for this patient" Q ;MAS
|
|---|
| 36 | S:'$D(IOM) IOM=80 W !!?10,"ADMISSION DATE",?35,"DISCHARGE DATE" D DASH^LRX
|
|---|
| 37 | S L=0,LRI=0
|
|---|
| 38 | F M=0:0 S L=$O(^DGPM("ATID1",DFN,L)) Q:L<1 D A ;MAS
|
|---|
| 39 | 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
|
|---|
| 40 | Q
|
|---|
| 41 | OUT I $D(ZTSK) K ZTSK Q
|
|---|
| 42 | D DIS,END Q
|
|---|
| 43 | 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
|
|---|
| 44 | 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
|
|---|
| 45 | Q
|
|---|
