LRAPS.m

LRAPS ; IHS/DIR/AAB - AP PATIENT SCREEN DISPLAY 8/6/97 14:06 ; [ 05/04/98 4:23 PM ]

 ;;5.2;LR;**1003**;JUN 01, 1998

 ;;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

 W @IOF,$E(LRP,1,30),?31,HRCN,?50,"DOB: ",DOB,?68,"LOC: ",$E(LRLLOC,1,5) Q  ;IHS/DIR TUC/AAB 5/4/98

LRAPS     ; IHS/DIR/AAB - AP PATIENT SCREEN DISPLAY 8/6/97 14:06 ; [ 05/04/98 4:23 PM ]

 +1       ;;5.2;LR;**1003**;JUN 01, 1998

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

 +3        IF '$DATA(DUZ)

               QUIT 

 +4        SET LR("Q")=0

           SET LRS(5)=1

           SET IOP="HOME"

           DO L^LRU

           DO EN^LRUA

           DO ^%ZIS

           SET LRDPAF=1

 +5        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       ;W @IOF,$E(LRP,1,30),?31,SSN,?50,"DOB: ",DOB,?68,"LOC: ",$E(LRLLOC,1,5) Q

 +1       ;IHS/DIR TUC/AAB 5/4/98

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

           QUIT