- 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
