- 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 Jan 18, 2025@03:23:41 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