LRWD.m

LRWD ;SLC/RWF-DISPLAY NAMES OF PATIENTS WITH RECENTLY VERIFIED DATA ;8/11/97 [ 04/10/2003  12:13 PM ]

 ;;5.2T9;LR;**1003,1018**;Nov 17, 2004

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

 ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018

 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 !,HRCN,?16,VADM(1)  ;IHS/ANMC/CLS 08/18/96

 ;----- END IHS MODIFICATIONS

 Q

LRWD      ;SLC/RWF-DISPLAY NAMES OF PATIENTS WITH RECENTLY VERIFIED DATA ;8/11/97 [ 04/10/2003  12:13 PM ]

 +1       ;;5.2T9;LR;**1003,1018**;Nov 17, 2004

 +2       ;;5.2;LAB SERVICE;**121,221**;Sep 27, 1994

 +3        DO D

           KILL DIC,LRDC,LRDFN,DFN,LRDPF

 +4        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       ;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)

 +2       ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018

 +3       ;IHS/ANMC/CLS 08/18/96

           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 !,HRCN,?16,VADM(1)

 +4       ;----- END IHS MODIFICATIONS

 +5        QUIT