- 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 ---[H[J[2J[HLRAPS 921 printed Jan 18, 2025@03:08:54 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