46 lines
2.7 KiB
Mathematica
46 lines
2.7 KiB
Mathematica
|
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
|