source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRARVER.m@ 1800

Last change on this file since 1800 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.8 KB
Line 
1LRARVER ;DALISC/CKA - LAB ARCHIVING VERIFY;8/25/95 ;10/2/95 09:12
2 ;;5.2;LAB SERVICE;**59**;July 31, 1995
3VER ;VERIFY FILES 64.1, 67.9, OR 65
4 S DIR(0)="S^1:WKLD DATA;2:LAB MONTHLY WORKLOADS"
5 S DIR("A")="FILE"
6 D ^DIR K DIR
7 I $D(DIRUT)!('Y) G EXIT
8 S LRART=$S(Y=1:64.1,Y=2:67.9,1:0)
9 I 'LRART G EXIT
10 S DIR(0)="S^1:WHOLE FILE;2:Selected entries for archiving"
11 S DIR("A")="NUMBER"
12 D ^DIR K DIR
13 I $D(DIRUT)!('Y) G EXIT
14 S LRARX=Y
15 I $D(DIRUT) G EXIT
16 I LRARX=1 D ALL G CLOSE
17 I LRARX=2 D SELECT G CLOSE
18 G EXIT
19ALL D VER^DIV(LRART)
20 Q
21SELECT ;Verify only selected entries for archiving
22 S LRARC=0,LRARC=$O(^LAB(95.11,"O",1,LRART,LRARC))
23 I 'LRARC W !!,$C(7),"No archival activity for this file in SELECT status" Q
24VBI ;Verify Blood Inventory selected entries
25 I LRART=65 D Q
26 . S LRARF="[LR ARCHIVE 65]"
27 . D VER^DIV(LRART,LRARF)
28 ;Set up selection criteria for either 64.1 or 67.9
29 S LRSEL=^LAB(95.11,LRARC,1)
30 I LRART=64.1 S LRED=$P(LRSEL,U,2)+.99,LRBD=$P(LRSEL,U)-.0001
31 I LRART=67.9 S LRED=$P(LRSEL,U,2)+.99,LRBD=$P(LRSEL,U)-100
32 S LRSCR="I $P(^(0),U)<"_LRED_",$P(^(0),U)>"_LRBD
33 I LRART=64.1 D VWD
34 I LRART=67.9 D VLMW
35CLOSE I $E(IOST)'="C" W @IOF
36 D ^%ZISC
37EXIT K DIR,DIRUT,LRARC,LRARDA,LRARDA1,LRARDA2,LRARDATE,LRARDIV,LRARF,LRARI,LRARI1,LRARI2,LRARIENS,LRARIN,LRARNUM
38 K LRARNUM1,LRARNUM2,LRART,LRARX,LRBD,LRED,LRIENS1,LRIENS2,LRSCR,LRSEL,LRWIN,Y
39 D CLN^LRARU1
40 Q
41VWD ;Verify WKLD DATA selected entries
42 D I $D(LRWIN) D VER^DIV(64.11,.LRWIN)
43 . D LIST^DIC(64.1,"","","","","","","","","","LRARIN","LRAROUT")
44 . S LRARNUM=$P(LRARIN("DILIST",0),U)
45 . F LRARI=1:1:LRARNUM S LRARDA=LRARIN("DILIST",2,LRARI),LRARIENS=$$IENS^DILF(.LRARDA),LRARIENS=","_LRARIENS D
46 .. D LIST^DIC(64.11,LRARIENS,"","","","","","",.LRSCR,"","LRARDATE","LRAROUT")
47 .. S LRARNUM1=$P(LRARDATE("DILIST",0),U)
48 .. Q:'LRARNUM1
49 .. F LRARI1=1:1:LRARNUM1 S LRARDA1=LRARDATE("DILIST",2,LRARI1),LRARDA1(1)=LRARDA,LRIENS1=$$IENS^DILF(.LRARDA1),LRWIN(LRIENS1)=""
50 I '$D(LRWIN) W !!!,$C(7),"NO records to verify.",!!
51 Q
52VLMW ;Verify LAB MONTHLY WORKLOADS selected entries
53 D I $D(LRWIN) D VER^DIV(67.911,.LRWIN)
54 . D LIST^DIC(67.9,"","","","","","","","","","LRARIN","LRAROUT")
55 . S LRARNUM=$P(LRARIN("DILIST",0),U)
56 . F LRARI=1:1:LRARNUM S LRARDA=LRARIN("DILIST",2,LRARI),LRARIENS=$$IENS^DILF(.LRARDA),LRARIENS=","_LRARIENS D
57 .. D LIST^DIC(67.901,LRARIENS,"","","","","","","","","LRARDIV","LRAROUT")
58 .. S LRARNUM1=$P(LRARDIV("DILIST",0),U)
59 .. Q:'LRARNUM1
60 .. F LRARI1=1:1:LRARNUM1 S LRARDA1=LRARDIV("DILIST",2,LRARI1),LRARDA1(1)=LRARDA,LRIENS1=","_$$IENS^DILF(.LRARDA1) D
61 ... D LIST^DIC(67.911,LRIENS1,"","","","","","",.LRSCR,"","LRARDATE","LRAROUT")
62 ... S LRARNUM2=$P(LRARDATE("DILIST",0),U)
63 ... Q:'LRARNUM2
64 ... F LRARI2=1:1:LRARNUM2 S LRARDA2=LRARDATE("DILIST",2,LRARI2),LRARDA2(2)=LRARDA,LRARDA2(1)=LRARDA1,LRIENS2=$$IENS^DILF(.LRARDA2),LRWIN(LRIENS2)=""
65 I '$D(LRWIN) W !!!,$C(7),"NO records to verify.",!!
66 Q
Note: See TracBrowser for help on using the repository browser.