Routine: LRAPS3

LRAPS3 ;SLC/DCM - AP PATIENT SCREEN DISPLAY FOR OE/RR ;12/10/90  12:21

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

OERR ;ENTRY POINT FOR OE/RR PATIENT LISTS

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

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

 S LRQ=1 D INI^LRBLPD1

GETP S LRA("A")=""

 I '$D(^LR(LRDFN,"CY")),'$D(^("SP")),'$D(^("EM")),'$D(^("AU")) W $C(7),!!,"No tissue pathology results for this patient.",!! Q

 G:'$D(^LR(LRDFN,"SP"))&('$D(^("CY")))&('$D(^("EM"))) AU

 D HDR,S^LRAPS1 Q:LRA("A")]""

AU I $D(^LR(LRDFN,"AU")),+^("AU") D ^LRAPS2 K LRAU

HDR W @IOF,$E(LRP,1,30),?31,SSN,?43,SEX,?45,"DOB: ",DOB,?63,"LOC: ",$E(LRLLOC,1,12) Q

SET S LR("Q")=0,LRS(5)=1 D L^LRU,EN^LRUA S LRDPAF=1

CLEAN ;

 K AGE,B,DFN,DOB,E,H,I,LR,LRA,LRADM,LRADX,LRAU,LRAWRD,LRDFN,LRDPAF,LRDPF,LRFNAM,LRH,LRI,LRMD,LRP,LRPF,LRPFN,LRS,LRSVC,M,N,O,P,S,SEX,SSN,W,X,Y

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRAPS3   943     printed  Dec 13, 2024@02:08:14                                                                                                                                                                                                       Page 2

LRAPS3    ;SLC/DCM - AP PATIENT SCREEN DISPLAY FOR OE/RR ;12/10/90  12:21

 +1       ;;5.2;LAB SERVICE;**242**;Sep 27, 1994

OERR      ;ENTRY POINT FOR OE/RR PATIENT LISTS

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

           IF 'LRDFN

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

               QUIT

 +2        SET LRDPF="2^DPT("

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

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

               QUIT

 +3        SET LRQ=1

           DO INI^LRBLPD1

GETP       SET LRA("A")=""

 +1        IF '$DATA(^LR(LRDFN,"CY"))

               IF '$DATA(^("SP"))

                   IF '$DATA(^("EM"))

                       IF '$DATA(^("AU"))

                           WRITE $CHAR(7),!!,"No tissue pathology results for this patient.",!!

                           QUIT

 +2        if '$DATA(^LR(LRDFN,"SP"))&('$DATA(^("CY")))&('$DATA(^("EM")))

               GOTO AU

 +3        DO HDR

           DO S^LRAPS1

           if LRA("A")]""

               QUIT

AU         IF $DATA(^LR(LRDFN,"AU"))

               IF +^("AU")

                   DO ^LRAPS2

                   KILL LRAU

 +1        QUIT

HDR        WRITE @IOF,$EXTRACT(LRP,1,30),?31,SSN,?43,SEX,?45,"DOB: ",DOB,?63,"LOC: ",$EXTRACT(LRLLOC,1,12)

           QUIT

SET        SET LR("Q")=0

           SET LRS(5)=1

           DO L^LRU

           DO EN^LRUA

           SET LRDPAF=1

 +1        QUIT

CLEAN     ;

 +1        KILL AGE,B,DFN,DOB,E,H,I,LR,LRA,LRADM,LRADX,LRAU,LRAWRD,LRDFN,LRDPAF,LRDPF,LRFNAM,LRH,LRI,LRMD,LRP,LRPF,LRPFN,LRS,LRSVC,M,N,O,P,S,SEX,SSN,W,X,Y

 +2        QUIT

LRAPS3.m