LRWD ;SLC/RWF-DISPLAY NAMES OF PATIENTS WITH RECENTLY VERIFIED DATA ;8/11/97
;;5.2;LAB SERVICE;**121,221**;Sep 27, 1994
D D K DIC,LRDC,LRDFN,DFN,LRDPF
Q
D S DIC=44,DIC(0)="AEMOQZ" D ^DIC I Y<1 Q
S LROLLOC=+Y,LRTREA=$P(Y(0),U,20)
S LRLLOC=$P(Y(0),U,2)
I $$VER^LR7OU1<3 S ORL=+Y_";SC(" ;OE/RR 2.5
Q:LRLLOC=""
Q:'$D(^LRO(69,"AN",LRLLOC)) S LRDC=0
S LRDFN=0 F S LRDFN=$O(^LRO(69,"AN",LRLLOC,LRDFN)) Q:LRDFN<1 I $D(^(LRDFN))[0 S ^(LRDFN)="" D WRT
Q:LRDC W !,"There is patient data. Want to see the FULL list" S %=2 D YN^DICN Q:%'=1
S LRDFN=0 F S LRDFN=$O(^LRO(69,"AN",LRLLOC,LRDFN)) Q:LRDFN<1 D WRT
Q
WRT I 'LRDC W !!,$C(7),"PATIENTS with NEW lab data",!,$C(7) S LRDC=1
S X=$S($D(^LR(LRDFN,0)):^(0),1:""),DFN=$P(X,U,3),LRDPF=$P(X,U,2) I LRDPF=2 D DEM^LRX W !,SSN,?16,VADM(1)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRWD 809 printed Oct 16, 2024@18:23:43 Page 2
LRWD ;SLC/RWF-DISPLAY NAMES OF PATIENTS WITH RECENTLY VERIFIED DATA ;8/11/97
+1 ;;5.2;LAB SERVICE;**121,221**;Sep 27, 1994
+2 DO D
KILL DIC,LRDC,LRDFN,DFN,LRDPF
+3 QUIT
D SET DIC=44
SET DIC(0)="AEMOQZ"
DO ^DIC
IF Y<1
QUIT
+1 SET LROLLOC=+Y
SET LRTREA=$PIECE(Y(0),U,20)
+2 SET LRLLOC=$PIECE(Y(0),U,2)
+3 ;OE/RR 2.5
IF $$VER^LR7OU1<3
SET ORL=+Y_";SC("
+4 if LRLLOC=""
QUIT
+5 if '$DATA(^LRO(69,"AN",LRLLOC))
QUIT
SET LRDC=0
+6 SET LRDFN=0
FOR
SET LRDFN=$ORDER(^LRO(69,"AN",LRLLOC,LRDFN))
if LRDFN<1
QUIT
IF $DATA(^(LRDFN))[0
SET ^(LRDFN)=""
DO WRT
+7 if LRDC
QUIT
WRITE !,"There is patient data. Want to see the FULL list"
SET %=2
DO YN^DICN
if %'=1
QUIT
+8 SET LRDFN=0
FOR
SET LRDFN=$ORDER(^LRO(69,"AN",LRLLOC,LRDFN))
if LRDFN<1
QUIT
DO WRT
+9 QUIT
WRT IF 'LRDC
WRITE !!,$CHAR(7),"PATIENTS with NEW lab data",!,$CHAR(7)
SET LRDC=1
+1 SET X=$SELECT($DATA(^LR(LRDFN,0)):^(0),1:"")
SET DFN=$PIECE(X,U,3)
SET LRDPF=$PIECE(X,U,2)
IF LRDPF=2
DO DEM^LRX
WRITE !,SSN,?16,VADM(1)
+2 QUIT
