LRAPS3.m

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

 ;;5.2;LR;**1018,1031**;Nov 1, 1997

 ;

 ;;VA LR Patch(s): 242

 ;

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

 Q

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

 W @IOF,$E(LRP,1,30),?31,$G(HRCN),?43,SEX,?45,"DOB: ",DOB,?63,"LOC: ",$E(LRLLOC,1,12) Q    ; IHS/MSC/MKK - LR*5.2*1031 -- Restore LR*5.2*1018 code

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

 Q

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

 K HRCN       ; IHS/MSC/MKK - LR*5.2*1031 -- Restore LR*5.2*1018 code

 Q

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

 +1       ;;5.2;LR;**1018,1031**;Nov 1, 1997

 +2       ;

 +3       ;;VA LR Patch(s): 242

 +4       ;

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       ; W @IOF,$E(LRP,1,30),?31,SSN,?43,SEX,?45,"DOB: ",DOB,?63,"LOC: ",$E(LRLLOC,1,12) Q

 +1       ; IHS/MSC/MKK - LR*5.2*1031 -- Restore LR*5.2*1018 code

           WRITE @IOF,$EXTRACT(LRP,1,30),?31,$GET(HRCN),?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       ; IHS/MSC/MKK - LR*5.2*1031 -- Restore LR*5.2*1018 code

           KILL HRCN

 +3        QUIT