LRMINEW1 ;DALOI/STAFF - NEW DATA TO BE REVIEWED/VERIFIED ;02/26/13 16:21
;;5.2;LAB SERVICE;**295,350,427**;Sep 27, 1994;Build 33
;
;
VER ;
N DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
;
W !!,"Indicate those you wish to exclude from verification."
D CHECK
;
I $O(LRAN(0))>0 D
. W !,"Verifying all but the following:"
. S LRAN=0
. F S LRAN=$O(LRAN(LRAN)) Q:LRAN="" W !,LRAN
;
S DIR(0)="YO"
S DIR("A")="Want the approved reports to be printed at the requesting locations"
S DIR("B")="NO"
D ^DIR
I $D(DIRUT) Q
S LRMIQUE=+Y
;
K DIR
S DIR(0)="YO"
S DIR("A")="Are you ready to verify",DIR("B")="NO"
S DIR("?",1)="If you're not sure, it's not too late to quit."
S DIR("?")="Enter either 'Y' or 'N'."
D ^DIR
I Y'=1 Q
;
S LRAN=0 F S LRAN=+$O(LRAN(LRAN)) Q:LRAN<1 K ^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN)
S LRAN=0 F S LRAN=+$O(^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN)) Q:LRAN<1 I +^(LRAN)=LRDXZ!(LRDXZ=0) D STUFF
W !,"ALL DONE"
;
Q
;
;
STUFF ;
Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) Q:'$D(^(3))
;
S Y=^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRDFN=+Y,LRLLOC=$P(Y,U,7),LRODT=$S($P(Y,U,4):$P(Y,U,4),1:$P(Y,U,3)),LRSN=$P(Y,U,5)
S LRIDT=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),"^",5)
I LRIDT="" S LRIDT=9999999-^LRO(68,LRAA,1,LRAD,1,LRAN,3)
;
S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3)
D PT^LRX
;
S DT=$$DT^XLFDT
S $P(^LR(LRDFN,"MI",LRIDT,LRSB),U)=$$NOW^XLFDT,$P(^(LRSB),U,$S(LRSB=11:5,1:3))=DUZ
;
I LRDPF=2 D UPDATE^LRPXRM(LRDFN,"MI",LRIDT)
I $G(LRSS)="" S LRSS="MI"
D SETRL^LRVERA(LRDFN,LRSS,LRIDT,DUZ(2))
I LRDPF=67 D SETTMP^LRVRMI5
;
S LRCDT=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),"^")
S Y=DT D VT^LRMIUT1
K ^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN)
D:LRMIQUE TSKM^LRMIUT
Q
;
;
CHECK ;from LRMINEW
D LRAN^LRMIUT
S LRAN=0
F S LRAN=+$O(LRAN(LRAN)) Q:LRAN<1 S LROK=1 D CHECK1 I 'LROK K LRAN(LRAN)
Q
;
;
CHECK1 ;
I '$D(^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN)) W !,LRAN," is not defined." S LROK=0 Q
I LRDXZ'=0,+^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN)'=LRDXZ W !,LRAN," is not your accession." S LROK=0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRMINEW1 2085 printed Oct 16, 2024@18:17:51 Page 2
LRMINEW1 ;DALOI/STAFF - NEW DATA TO BE REVIEWED/VERIFIED ;02/26/13 16:21
+1 ;;5.2;LAB SERVICE;**295,350,427**;Sep 27, 1994;Build 33
+2 ;
+3 ;
VER ;
+1 NEW DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
+2 ;
+3 WRITE !!,"Indicate those you wish to exclude from verification."
+4 DO CHECK
+5 ;
+6 IF $ORDER(LRAN(0))>0
Begin DoDot:1
+7 WRITE !,"Verifying all but the following:"
+8 SET LRAN=0
+9 FOR
SET LRAN=$ORDER(LRAN(LRAN))
if LRAN=""
QUIT
WRITE !,LRAN
End DoDot:1
+10 ;
+11 SET DIR(0)="YO"
+12 SET DIR("A")="Want the approved reports to be printed at the requesting locations"
+13 SET DIR("B")="NO"
+14 DO ^DIR
+15 IF $DATA(DIRUT)
QUIT
+16 SET LRMIQUE=+Y
+17 ;
+18 KILL DIR
+19 SET DIR(0)="YO"
+20 SET DIR("A")="Are you ready to verify"
SET DIR("B")="NO"
+21 SET DIR("?",1)="If you're not sure, it's not too late to quit."
+22 SET DIR("?")="Enter either 'Y' or 'N'."
+23 DO ^DIR
+24 IF Y'=1
QUIT
+25 ;
+26 SET LRAN=0
FOR
SET LRAN=+$ORDER(LRAN(LRAN))
if LRAN<1
QUIT
KILL ^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN)
+27 SET LRAN=0
FOR
SET LRAN=+$ORDER(^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN))
if LRAN<1
QUIT
IF +^(LRAN)=LRDXZ!(LRDXZ=0)
DO STUFF
+28 WRITE !,"ALL DONE"
+29 ;
+30 QUIT
+31 ;
+32 ;
STUFF ;
+1 if '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,0))
QUIT
if '$DATA(^(3))
QUIT
+2 ;
+3 SET Y=^LRO(68,LRAA,1,LRAD,1,LRAN,0)
SET LRDFN=+Y
SET LRLLOC=$PIECE(Y,U,7)
SET LRODT=$SELECT($PIECE(Y,U,4):$PIECE(Y,U,4),1:$PIECE(Y,U,3))
SET LRSN=$PIECE(Y,U,5)
+4 SET LRIDT=$PIECE(^LRO(68,LRAA,1,LRAD,1,LRAN,3),"^",5)
+5 IF LRIDT=""
SET LRIDT=9999999-^LRO(68,LRAA,1,LRAD,1,LRAN,3)
+6 ;
+7 SET LRDPF=$PIECE(^LR(LRDFN,0),U,2)
SET DFN=$PIECE(^(0),U,3)
+8 DO PT^LRX
+9 ;
+10 SET DT=$$DT^XLFDT
+11 SET $PIECE(^LR(LRDFN,"MI",LRIDT,LRSB),U)=$$NOW^XLFDT
SET $PIECE(^(LRSB),U,$SELECT(LRSB=11:5,1:3))=DUZ
+12 ;
+13 IF LRDPF=2
DO UPDATE^LRPXRM(LRDFN,"MI",LRIDT)
+14 IF $GET(LRSS)=""
SET LRSS="MI"
+15 DO SETRL^LRVERA(LRDFN,LRSS,LRIDT,DUZ(2))
+16 IF LRDPF=67
DO SETTMP^LRVRMI5
+17 ;
+18 SET LRCDT=$PIECE(^LRO(68,LRAA,1,LRAD,1,LRAN,3),"^")
+19 SET Y=DT
DO VT^LRMIUT1
+20 KILL ^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN)
+21 if LRMIQUE
DO TSKM^LRMIUT
+22 QUIT
+23 ;
+24 ;
CHECK ;from LRMINEW
+1 DO LRAN^LRMIUT
+2 SET LRAN=0
+3 FOR
SET LRAN=+$ORDER(LRAN(LRAN))
if LRAN<1
QUIT
SET LROK=1
DO CHECK1
IF 'LROK
KILL LRAN(LRAN)
+4 QUIT
+5 ;
+6 ;
CHECK1 ;
+1 IF '$DATA(^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN))
WRITE !,LRAN," is not defined."
SET LROK=0
QUIT
+2 IF LRDXZ'=0
IF +^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN)'=LRDXZ
WRITE !,LRAN," is not your accession."
SET LROK=0
+3 QUIT
