Routine: LRWD

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

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

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)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRWD   809     printed  Apr 09, 2024@21:23:07                                                                                                                                                                                                         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

LRWD.m