LRGEN ;SLC/RWF - GENERAL REPORT FOR SELECTED TESTS ;8/11/97
;;5.2;LAB SERVICE;**121,201,202,242**;Sep 27, 1994
;from option LRGEN
BEGIN D ^LRPARAM W !!?20,"GENERAL LAB DATA DISPLAY"
K DIC,LRTP S (LRTP,LREND)=0 D ^LRDPA I LRDFN'=-1 D GEN
END K ^TMP("LR",$J),A8,C,DFN,DOB,DTOUT,DUOUT,I,II,IOBS,J,LRAA,LRAAC,LRAD,LRAN,LRCMNT,LRCW,LRDAT,LRDFN,LRDPF,LREDT,LREND,LREX,LREXPD,LRFFLG,LRFOOT,LRHDR,LRHI,LRIDT,LRIDT1,LRIX,LRLLT,LRLO,LRND,LRNG,LRNON,LRNOP,LRNOTE,LRONESPC,LRONETST
K LRORD,LRPAGE,LRPG,LRPP,LRPR,LRPS,LRSC,LRSDT,LRSSP,LRSUB,LRSV,LRTEST,LRTHER,LRTN,LRTP,LRTSTS,LRWPL,LRWRD,LRX,LRY,PNM,POP,S,S1,S2,SSN,T,X,Y,Z
K LRODT0
Q
GEN I $O(^LR(LRDFN,0))="" W !,"NO LAB DATA ON THIS PATIENT!",$C(7) Q
S LRCW=10,LRPAGE=0 K ^TMP("LR",$J),LRTSTS,LRORD,LRTEST,LRSUB,LRHDR,LRSSP,LRHI,LRLO
D TESTS^LRGEN2 K DIC Q:LREND!'LRTSTS I LRTSTS>18 D GEN^LRRP2 Q
DATE S LREDT="T-14" D ^LRWU3 Q:LREND S LREDT=9999999-LREDT K LRSV,DIC
Q:LRIX=0 S LREND=0,LRWPL=IOSL-(3*LRIX)\LRIX,LRSC=LRIX,LRIDT=9999999-LRSDT
F II=1:1:LRIX S LRIDT(II)=LRIDT
S %ZIS="MQ",ZTRTN="DQ^LRGEN1" D IO^LRWU
Q
EN2 ;from LRSOR1
D DATE
Q
OR ;OE/RR entry point
Q:'$D(ORVP) S KILL=1 I '$D(LRPARAM) D EN^LRPARAM S KILL=0
D DT^LRX K DIC,LRTP S (LRTP,LREND)=0,DFN=+ORVP,LRDPF=+$P(@("^"_$P(ORVP,";",2)_"0)"),"^",2)_"^"_$P(ORVP,";",2) D END^LRDPA Q:LRDFN<1
D GEN,END
I 'KILL K LRBLOOD,LRDT0,LRPARAM,LRPLASMA,LRSERUM,LRUNKNOW,LRURINE
K KILL Q
SET ;Initial Set up for CPRS call
N LRDONT
S (LRTP,LRPAGE,LREND)=0,LRCW=10,LRDONT=1
D SET^LRRP4,TESTS^LRGEN2
Q
SET1 ;Print patient report for CPRS
I '$D(^DPT(DFN,"LR")) W !,"No Lab Data for: "_$P(^(0),"^") Q
S LRDFN=$$LRDFN^LR7OR1(DFN) I 'LRDFN W !,"No Lab Data for: "_$P(^DPT(DFN,0),"^") Q
I '$D(^LR(LRDFN,0)) W !,"No Lab Data for: "_$P(^DPT(DFN,0),"^") Q
I $D(LRPRETTY),$O(LRTEST(0)) S X=LRTEST($O(LRTEST(0))) I $L(X) D @X Q
I LRTSTS>18 W !!,"Too many tests! Will use alternate format. May show extra tests." S (LREND,LRFOOT,LRSTOP)=0,LRCW=8,LRHF=1,(LRONESPC,LRONETST)="" D GDQ^LRRP2 Q
S LRWPL=IOSL-(3*LRIX)\LRIX,LRSC=LRIX,LRIDT=LRSDT
F II=1:1:LRIX S LRIDT(II)=LRIDT
U IO S LRCW=LRCW-3,LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3),LRY=2 D DT^LRX,PT^LRX
D HEAD^LRGEN1
F I=0:0 D NX^LRGEN1 Q:LREND
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRGEN 2260 printed Nov 22, 2024@17:24:57 Page 2
LRGEN ;SLC/RWF - GENERAL REPORT FOR SELECTED TESTS ;8/11/97
+1 ;;5.2;LAB SERVICE;**121,201,202,242**;Sep 27, 1994
+2 ;from option LRGEN
BEGIN DO ^LRPARAM
WRITE !!?20,"GENERAL LAB DATA DISPLAY"
+1 KILL DIC,LRTP
SET (LRTP,LREND)=0
DO ^LRDPA
IF LRDFN'=-1
DO GEN
END KILL ^TMP("LR",$JOB),A8,C,DFN,DOB,DTOUT,DUOUT,I,II,IOBS,J,LRAA,LRAAC,LRAD,LRAN,LRCMNT,LRCW,LRDAT,LRDFN,LRDPF,LREDT,LREND,LREX,LREXPD,LRFFLG,LRFOOT,LRHDR,LRHI,LRIDT,LRIDT1,LRIX,LRLLT,LRLO,LRND,LRNG,LRNON,LRNOP,LRNOTE,LRONESPC,LRONETST
+1 KILL LRORD,LRPAGE,LRPG,LRPP,LRPR,LRPS,LRSC,LRSDT,LRSSP,LRSUB,LRSV,LRTEST,LRTHER,LRTN,LRTP,LRTSTS,LRWPL,LRWRD,LRX,LRY,PNM,POP,S,S1,S2,SSN,T,X,Y,Z
+2 KILL LRODT0
+3 QUIT
GEN IF $ORDER(^LR(LRDFN,0))=""
WRITE !,"NO LAB DATA ON THIS PATIENT!",$CHAR(7)
QUIT
+1 SET LRCW=10
SET LRPAGE=0
KILL ^TMP("LR",$JOB),LRTSTS,LRORD,LRTEST,LRSUB,LRHDR,LRSSP,LRHI,LRLO
+2 DO TESTS^LRGEN2
KILL DIC
if LREND!'LRTSTS
QUIT
IF LRTSTS>18
DO GEN^LRRP2
QUIT
DATE SET LREDT="T-14"
DO ^LRWU3
if LREND
QUIT
SET LREDT=9999999-LREDT
KILL LRSV,DIC
+1 if LRIX=0
QUIT
SET LREND=0
SET LRWPL=IOSL-(3*LRIX)\LRIX
SET LRSC=LRIX
SET LRIDT=9999999-LRSDT
+2 FOR II=1:1:LRIX
SET LRIDT(II)=LRIDT
+3 SET %ZIS="MQ"
SET ZTRTN="DQ^LRGEN1"
DO IO^LRWU
+4 QUIT
EN2 ;from LRSOR1
+1 DO DATE
+2 QUIT
OR ;OE/RR entry point
+1 if '$DATA(ORVP)
QUIT
SET KILL=1
IF '$DATA(LRPARAM)
DO EN^LRPARAM
SET KILL=0
+2 DO DT^LRX
KILL DIC,LRTP
SET (LRTP,LREND)=0
SET DFN=+ORVP
SET LRDPF=+$PIECE(@("^"_$PIECE(ORVP,";",2)_"0)"),"^",2)_"^"_$PIECE(ORVP,";",2)
DO END^LRDPA
if LRDFN<1
QUIT
+3 DO GEN
DO END
+4 IF 'KILL
KILL LRBLOOD,LRDT0,LRPARAM,LRPLASMA,LRSERUM,LRUNKNOW,LRURINE
+5 KILL KILL
QUIT
SET ;Initial Set up for CPRS call
+1 NEW LRDONT
+2 SET (LRTP,LRPAGE,LREND)=0
SET LRCW=10
SET LRDONT=1
+3 DO SET^LRRP4
DO TESTS^LRGEN2
+4 QUIT
SET1 ;Print patient report for CPRS
+1 IF '$DATA(^DPT(DFN,"LR"))
WRITE !,"No Lab Data for: "_$PIECE(^(0),"^")
QUIT
+2 SET LRDFN=$$LRDFN^LR7OR1(DFN)
IF 'LRDFN
WRITE !,"No Lab Data for: "_$PIECE(^DPT(DFN,0),"^")
QUIT
+3 IF '$DATA(^LR(LRDFN,0))
WRITE !,"No Lab Data for: "_$PIECE(^DPT(DFN,0),"^")
QUIT
+4 IF $DATA(LRPRETTY)
IF $ORDER(LRTEST(0))
SET X=LRTEST($ORDER(LRTEST(0)))
IF $LENGTH(X)
DO @X
QUIT
+5 IF LRTSTS>18
WRITE !!,"Too many tests! Will use alternate format. May show extra tests."
SET (LREND,LRFOOT,LRSTOP)=0
SET LRCW=8
SET LRHF=1
SET (LRONESPC,LRONETST)=""
DO GDQ^LRRP2
QUIT
+6 SET LRWPL=IOSL-(3*LRIX)\LRIX
SET LRSC=LRIX
SET LRIDT=LRSDT
+7 FOR II=1:1:LRIX
SET LRIDT(II)=LRIDT
+8 USE IO
SET LRCW=LRCW-3
SET LRDPF=$PIECE(^LR(LRDFN,0),U,2)
SET DFN=$PIECE(^(0),U,3)
SET LRY=2
DO DT^LRX
DO PT^LRX
+9 DO HEAD^LRGEN1
+10 FOR I=0:0
DO NX^LRGEN1
if LREND
QUIT
+11 QUIT
