- LRGEN ;SLC/RWF - GENERAL REPORT FOR SELECTED TESTS ;8/11/97 [ 04/14/2003 8:08 AM ]
- ;;5.2T9;LR;**1003,1006,1018**;Nov 17, 2004
- ;;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
- ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018
- 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,HRCN,T,X,Y,Z ;IHS/ANMC/CLS 11/1/95
- ;----- END IHS MODIFICATIONS
- 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
- LRGEN ;SLC/RWF - GENERAL REPORT FOR SELECTED TESTS ;8/11/97 [ 04/14/2003 8:08 AM ]
- +1 ;;5.2T9;LR;**1003,1006,1018**;Nov 17, 2004
- +2 ;;5.2;LAB SERVICE;**121,201,202,242**;Sep 27, 1994
- +3 ;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 ;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
- +2 ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018
- +3 ;IHS/ANMC/CLS 11/1/95
- 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,HRCN,T,X,Y,Z
- +4 ;----- END IHS MODIFICATIONS
- +5 KILL LRODT0
- +6 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
