LRAPS.m

LRAPS ;AVAMC/REG/CYM - AP PATIENT SCREEN DISPLAY ;8/6/97  14:06 ;

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

 Q:'$D(DUZ)

 S LR("Q")=0,LRS(5)=1,IOP="HOME" D L^LRU,EN^LRUA,^%ZIS S LRDPAF=1

 W @IOF,!?15,"DISPLAY cum path data summary for a patient"

GETP W ! S LRA("A")="" K DIC D ^LRDPA I LRDFN=-1 D V^LRU Q

 W !!,"Is this the patient " S %=1 D YN^LRU Q:%<1  G:%=2 GETP

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

 I DOB[1700 S DOB=""

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

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

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

 G GETP

M F X=0:0 Q:$Y>(IOSL-4)  W !

 Q:LRA("A")]""  R !!,"'^' TO STOP: ",LRA("A"):DTIME S:'$T LRA("A")="^" Q:LRA("A")="^"  I LRA("A")]"" S LRA("A")="" W $C(7) G M

 Q

HDR W @IOF,$E(LRP,1,30),?31,SSN,?50,"DOB: ",DOB,?68,"LOC: ",$E(LRLLOC,1,5) Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LRAPS   921     printed  Apr 09, 2024@21:21:15                                                                                                                                                                                                        Page 2

LRAPS     ;AVAMC/REG/CYM - AP PATIENT SCREEN DISPLAY ;8/6/97  14:06 ;

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

 +2        if '$DATA(DUZ)

               QUIT 

 +3        SET LR("Q")=0

           SET LRS(5)=1

           SET IOP="HOME"

           DO L^LRU

           DO EN^LRUA

           DO ^%ZIS

           SET LRDPAF=1

 +4        WRITE @IOF,!?15,"DISPLAY cum path data summary for a patient"

GETP       WRITE !

           SET LRA("A")=""

           KILL DIC

           DO ^LRDPA

           IF LRDFN=-1

               DO V^LRU

               QUIT 

 +1        WRITE !!,"Is this the patient "

           SET %=1

           DO YN^LRU

           if %<1

               QUIT 

           if %=2

               GOTO GETP

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

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

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

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

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

                           GOTO GETP

 +3        IF DOB[1700

               SET DOB=""

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

               GOTO AU

 +5        DO HDR

           DO S^LRAPS1

           if LRA("A")]""

               GOTO GETP

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

               IF +^("AU")

                   DO ^LRAPS2

                   KILL LRAU

 +1        GOTO GETP

M          FOR X=0:0

               if $Y>(IOSL-4)

                   QUIT 

               WRITE !

 +1        if LRA("A")]""

               QUIT 

           READ !!,"'^' TO STOP: ",LRA("A"):DTIME

           if '$TEST

               SET LRA("A")="^"

           if LRA("A")="^"

               QUIT 

           IF LRA("A")]""

               SET LRA("A")=""

               WRITE $CHAR(7)

               GOTO M

 +2        QUIT 

HDR        WRITE @IOF,$EXTRACT(LRP,1,30),?31,SSN,?50,"DOB: ",DOB,?68,"LOC: ",$EXTRACT(LRLLOC,1,5)

           QUIT