LRARVER ; IHS/DIR/AAB - LAB ARCHIVING VERIFY 8/25/95 09:12 ; [ 07/22/2002 1:09 PM ]
;;5.2;LR;**1002,1013**;JUL 15, 2002
;;5.2;LAB SERVICE;**59**;July 31, 1995
VER ;VERIFY FILES 64.1, 67.9, OR 65
S DIR(0)="S^1:WKLD DATA;2:LAB MONTHLY WORKLOADS"
S DIR("A")="FILE"
D ^DIR K DIR
I $D(DIRUT)!('Y) G EXIT
S LRART=$S(Y=1:64.1,Y=2:67.9,1:0)
I 'LRART G EXIT
S DIR(0)="S^1:WHOLE FILE;2:Selected entries for archiving"
S DIR("A")="NUMBER"
D ^DIR K DIR
I $D(DIRUT)!('Y) G EXIT
S LRARX=Y
I $D(DIRUT) G EXIT
I LRARX=1 D ALL G CLOSE
I LRARX=2 D SELECT G CLOSE
G EXIT
ALL D VER^DIV(LRART)
Q
SELECT ;Verify only selected entries for archiving
S LRARC=0,LRARC=$O(^LAB(95.11,"O",1,LRART,LRARC))
I 'LRARC W !!,$C(7),"No archival activity for this file in SELECT status" Q
VBI ;Verify Blood Inventory selected entries
I LRART=65 D Q
. S LRARF="[LR ARCHIVE 65]"
. D VER^DIV(LRART,LRARF)
;Set up selection criteria for either 64.1 or 67.9
S LRSEL=^LAB(95.11,LRARC,1)
I LRART=64.1 S LRED=$P(LRSEL,U,2)+.99,LRBD=$P(LRSEL,U)-.0001
I LRART=67.9 S LRED=$P(LRSEL,U,2)+.99,LRBD=$P(LRSEL,U)-100
S LRSCR="I $P(^(0),U)<"_LRED_",$P(^(0),U)>"_LRBD
I LRART=64.1 D VWD
I LRART=67.9 D VLMW
CLOSE I $E(IOST)'="C" W @IOF
D ^%ZISC
EXIT K DIR,DIRUT,LRARC,LRARDA,LRARDA1,LRARDA2,LRARDATE,LRARDIV,LRARF,LRARI,LRARI1,LRARI2,LRARIENS,LRARIN,LRARNUM
K LRARNUM1,LRARNUM2,LRART,LRARX,LRBD,LRED,LRIENS1,LRIENS2,LRSCR,LRSEL,LRWIN,Y
D CLN^LRARU1
Q
VWD ;Verify WKLD DATA selected entries
D I $D(LRWIN) D VER^DIV(64.11,.LRWIN)
. D LIST^DIC(64.1,"","","","","","","","","","LRARIN","LRAROUT")
. S LRARNUM=$P(LRARIN("DILIST",0),U)
. F LRARI=1:1:LRARNUM S LRARDA=LRARIN("DILIST",2,LRARI),LRARIENS=$$IENS^DILF(.LRARDA),LRARIENS=","_LRARIENS D
.. D LIST^DIC(64.11,LRARIENS,"","","","","","",.LRSCR,"","LRARDATE","LRAROUT")
.. S LRARNUM1=$P(LRARDATE("DILIST",0),U)
.. Q:'LRARNUM1
.. F LRARI1=1:1:LRARNUM1 S LRARDA1=LRARDATE("DILIST",2,LRARI1),LRARDA1(1)=LRARDA,LRIENS1=$$IENS^DILF(.LRARDA1),LRWIN(LRIENS1)=""
I '$D(LRWIN) W !!!,$C(7),"NO records to verify.",!!
Q
VLMW ;Verify LAB MONTHLY WORKLOADS selected entries
D I $D(LRWIN) D VER^DIV(67.911,.LRWIN)
. D LIST^DIC(67.9,"","","","","","","","","","LRARIN","LRAROUT")
. S LRARNUM=$P(LRARIN("DILIST",0),U)
. F LRARI=1:1:LRARNUM S LRARDA=LRARIN("DILIST",2,LRARI),LRARIENS=$$IENS^DILF(.LRARDA),LRARIENS=","_LRARIENS D
.. D LIST^DIC(67.901,LRARIENS,"","","","","","","","","LRARDIV","LRAROUT")
.. S LRARNUM1=$P(LRARDIV("DILIST",0),U)
.. Q:'LRARNUM1
.. F LRARI1=1:1:LRARNUM1 S LRARDA1=LRARDIV("DILIST",2,LRARI1),LRARDA1(1)=LRARDA,LRIENS1=","_$$IENS^DILF(.LRARDA1) D
... D LIST^DIC(67.911,LRIENS1,"","","","","","",.LRSCR,"","LRARDATE","LRAROUT")
... S LRARNUM2=$P(LRARDATE("DILIST",0),U)
... Q:'LRARNUM2
... F LRARI2=1:1:LRARNUM2 S LRARDA2=LRARDATE("DILIST",2,LRARI2),LRARDA2(2)=LRARDA,LRARDA2(1)=LRARDA1,LRIENS2=$$IENS^DILF(.LRARDA2),LRWIN(LRIENS2)=""
I '$D(LRWIN) W !!!,$C(7),"NO records to verify.",!!
Q
LRARVER ; IHS/DIR/AAB - LAB ARCHIVING VERIFY 8/25/95 09:12 ; [ 07/22/2002 1:09 PM ]
+1 ;;5.2;LR;**1002,1013**;JUL 15, 2002
+2 ;;5.2;LAB SERVICE;**59**;July 31, 1995
VER ;VERIFY FILES 64.1, 67.9, OR 65
+1 SET DIR(0)="S^1:WKLD DATA;2:LAB MONTHLY WORKLOADS"
+2 SET DIR("A")="FILE"
+3 DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)!('Y)
GOTO EXIT
+5 SET LRART=$SELECT(Y=1:64.1,Y=2:67.9,1:0)
+6 IF 'LRART
GOTO EXIT
+7 SET DIR(0)="S^1:WHOLE FILE;2:Selected entries for archiving"
+8 SET DIR("A")="NUMBER"
+9 DO ^DIR
KILL DIR
+10 IF $DATA(DIRUT)!('Y)
GOTO EXIT
+11 SET LRARX=Y
+12 IF $DATA(DIRUT)
GOTO EXIT
+13 IF LRARX=1
DO ALL
GOTO CLOSE
+14 IF LRARX=2
DO SELECT
GOTO CLOSE
+15 GOTO EXIT
ALL DO VER^DIV(LRART)
+1 QUIT
SELECT ;Verify only selected entries for archiving
+1 SET LRARC=0
SET LRARC=$ORDER(^LAB(95.11,"O",1,LRART,LRARC))
+2 IF 'LRARC
WRITE !!,$CHAR(7),"No archival activity for this file in SELECT status"
QUIT
VBI ;Verify Blood Inventory selected entries
+1 IF LRART=65
Begin DoDot:1
+2 SET LRARF="[LR ARCHIVE 65]"
+3 DO VER^DIV(LRART,LRARF)
End DoDot:1
QUIT
+4 ;Set up selection criteria for either 64.1 or 67.9
+5 SET LRSEL=^LAB(95.11,LRARC,1)
+6 IF LRART=64.1
SET LRED=$PIECE(LRSEL,U,2)+.99
SET LRBD=$PIECE(LRSEL,U)-.0001
+7 IF LRART=67.9
SET LRED=$PIECE(LRSEL,U,2)+.99
SET LRBD=$PIECE(LRSEL,U)-100
+8 SET LRSCR="I $P(^(0),U)<"_LRED_",$P(^(0),U)>"_LRBD
+9 IF LRART=64.1
DO VWD
+10 IF LRART=67.9
DO VLMW
CLOSE IF $EXTRACT(IOST)'="C"
WRITE @IOF
+1 DO ^%ZISC
EXIT KILL DIR,DIRUT,LRARC,LRARDA,LRARDA1,LRARDA2,LRARDATE,LRARDIV,LRARF,LRARI,LRARI1,LRARI2,LRARIENS,LRARIN,LRARNUM
+1 KILL LRARNUM1,LRARNUM2,LRART,LRARX,LRBD,LRED,LRIENS1,LRIENS2,LRSCR,LRSEL,LRWIN,Y
+2 DO CLN^LRARU1
+3 QUIT
VWD ;Verify WKLD DATA selected entries
+1 Begin DoDot:1
+2 DO LIST^DIC(64.1,"","","","","","","","","","LRARIN","LRAROUT")
+3 SET LRARNUM=$PIECE(LRARIN("DILIST",0),U)
+4 FOR LRARI=1:1:LRARNUM
SET LRARDA=LRARIN("DILIST",2,LRARI)
SET LRARIENS=$$IENS^DILF(.LRARDA)
SET LRARIENS=","_LRARIENS
Begin DoDot:2
+5 DO LIST^DIC(64.11,LRARIENS,"","","","","","",.LRSCR,"","LRARDATE","LRAROUT")
+6 SET LRARNUM1=$PIECE(LRARDATE("DILIST",0),U)
+7 IF 'LRARNUM1
QUIT
+8 FOR LRARI1=1:1:LRARNUM1
SET LRARDA1=LRARDATE("DILIST",2,LRARI1)
SET LRARDA1(1)=LRARDA
SET LRIENS1=$$IENS^DILF(.LRARDA1)
SET LRWIN(LRIENS1)=""
End DoDot:2
End DoDot:1
IF $DATA(LRWIN)
DO VER^DIV(64.11,.LRWIN)
+9 IF '$DATA(LRWIN)
WRITE !!!,$CHAR(7),"NO records to verify.",!!
+10 QUIT
VLMW ;Verify LAB MONTHLY WORKLOADS selected entries
+1 Begin DoDot:1
+2 DO LIST^DIC(67.9,"","","","","","","","","","LRARIN","LRAROUT")
+3 SET LRARNUM=$PIECE(LRARIN("DILIST",0),U)
+4 FOR LRARI=1:1:LRARNUM
SET LRARDA=LRARIN("DILIST",2,LRARI)
SET LRARIENS=$$IENS^DILF(.LRARDA)
SET LRARIENS=","_LRARIENS
Begin DoDot:2
+5 DO LIST^DIC(67.901,LRARIENS,"","","","","","","","","LRARDIV","LRAROUT")
+6 SET LRARNUM1=$PIECE(LRARDIV("DILIST",0),U)
+7 IF 'LRARNUM1
QUIT
+8 FOR LRARI1=1:1:LRARNUM1
SET LRARDA1=LRARDIV("DILIST",2,LRARI1)
SET LRARDA1(1)=LRARDA
SET LRIENS1=","_$$IENS^DILF(.LRARDA1)
Begin DoDot:3
+9 DO LIST^DIC(67.911,LRIENS1,"","","","","","",.LRSCR,"","LRARDATE","LRAROUT")
+10 SET LRARNUM2=$PIECE(LRARDATE("DILIST",0),U)
+11 IF 'LRARNUM2
QUIT
+12 FOR LRARI2=1:1:LRARNUM2
SET LRARDA2=LRARDATE("DILIST",2,LRARI2)
SET LRARDA2(2)=LRARDA
SET LRARDA2(1)=LRARDA1
SET LRIENS2=$$IENS^DILF(.LRARDA2)
SET LRWIN(LRIENS2)=""
End DoDot:3
End DoDot:2
End DoDot:1
IF $DATA(LRWIN)
DO VER^DIV(67.911,.LRWIN)
+13 IF '$DATA(LRWIN)
WRITE !!!,$CHAR(7),"NO records to verify.",!!
+14 QUIT
