LRRP4.m

LRRP4 ;SLC/DCM - INTERIM REPORT FOR OE/RR PATIENT LISTS ;8/11/97 [ 04/14/2003  12:44 PM ]

 ;;5.2T9;LR;**1003,1018**;Nov 17, 2004

 ;;5.2;LAB SERVICE;**121,242**;Sep 27, 1994

OERR ;

 S LRDFN=$$LRDFN^LR7OR1(DFN) I 'LRDFN W !,"No Lab Data for: "_$P(^(0),"^") Q

 I '$D(^LR(LRDFN,0)) W !,"No Lab Data for: "_$P(^DPT(DFN,0),"^") Q

 D DS^LRRP2

 Q

CLEAN ;

 K DFN,DOB,LR0,LRAA,LRAAO,LRBLOOD,LRCDT,LRCMNT,LRCNIDT,LRCW,LRDATA,LRDFN,LRDN,LRDOC,LRDPF,LRDT0,LREDT,LREND,LRFFLG,LRFOOT,LRHF,LRHI,LRIDT,LRINTP,LRLAB,LRLABKY,LRLO,LRMNIDT,LROC,LRONESPC,LRONETST,LRPARAM,LRPC,LRPLASMA,LRPO

 ;K LRSERUM,LRSPEC,LRSS,LRSTOP,LRSUB,LRTC,LRTHER,LRTSTS,LRUNKNOW,LRURINE,LRWRD,OREND,ORI,ORJ,OROPREF,ORUVP,ORVP,ORY,PNM,SEX,SSN,LRJ0,LRJ02

 ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018

 K LRSERUM,LRSPEC,LRSS,LRSTOP,LRSUB,LRTC,LRTHER,LRTSTS,LRUNKNOW,LRURINE,LRWRD,OREND,ORI,ORJ,OROPREF,ORUVP,ORVP,ORY,PNM,SEX,SSN,HRCN,LRJ0,LRJ02  ;IHS/ANMC/CLS 08/18/96

 ;----- END IHS MODIFICATIONS

 Q

SET ;

 D:'$D(LRPARAM) EN^LRPARAM D:'$D(LRDT0) DT^LRX

 S LREND=0,(LRONETST,LRONESPC)="",LRLAB=$S($D(LRLABKY):1,1:0),LRIDT=0,LREDT=9999999

 Q

LRRP4     ;SLC/DCM - INTERIM REPORT FOR OE/RR PATIENT LISTS ;8/11/97 [ 04/14/2003  12:44 PM ]

 +1       ;;5.2T9;LR;**1003,1018**;Nov 17, 2004

 +2       ;;5.2;LAB SERVICE;**121,242**;Sep 27, 1994

OERR      ;

 +1        SET LRDFN=$$LRDFN^LR7OR1(DFN)

           IF 'LRDFN

               WRITE !,"No Lab Data for: "_$PIECE(^(0),"^")

               QUIT 

 +2        IF '$DATA(^LR(LRDFN,0))

               WRITE !,"No Lab Data for: "_$PIECE(^DPT(DFN,0),"^")

               QUIT 

 +3        DO DS^LRRP2

 +4        QUIT 

CLEAN     ;

 +1        KILL DFN,DOB,LR0,LRAA,LRAAO,LRBLOOD,LRCDT,LRCMNT,LRCNIDT,LRCW,LRDATA,LRDFN,LRDN,LRDOC,LRDPF,LRDT0,LREDT,LREND,LRFFLG,LRFOOT,LRHF,LRHI,LRIDT,LRINTP,LRLAB,LRLABKY,LRLO,LRMNIDT,LROC,LRONESPC,LRONETST,LRPARAM,LRPC,LRPLASMA,LRPO

 +2       ;K LRSERUM,LRSPEC,LRSS,LRSTOP,LRSUB,LRTC,LRTHER,LRTSTS,LRUNKNOW,LRURINE,LRWRD,OREND,ORI,ORJ,OROPREF,ORUVP,ORVP,ORY,PNM,SEX,SSN,LRJ0,LRJ02

 +3       ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018

 +4       ;IHS/ANMC/CLS 08/18/96

           KILL LRSERUM,LRSPEC,LRSS,LRSTOP,LRSUB,LRTC,LRTHER,LRTSTS,LRUNKNOW,LRURINE,LRWRD,OREND,ORI,ORJ,OROPREF,ORUVP,ORVP,ORY,PNM,SEX,SSN,HRCN,LRJ0,LRJ02

 +5       ;----- END IHS MODIFICATIONS

 +6        QUIT 

SET       ;

 +1        IF '$DATA(LRPARAM)

               DO EN^LRPARAM

           IF '$DATA(LRDT0)

               DO DT^LRX

 +2        SET LREND=0

           SET (LRONETST,LRONESPC)=""

           SET LRLAB=$SELECT($DATA(LRLABKY):1,1:0)

           SET LRIDT=0

           SET LREDT=9999999

 +3        QUIT