- LRARVER ;DALISC/CKA - LAB ARCHIVING VERIFY;8/25/95 ;10/2/95 09:12
- ;;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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRARVER 2966 printed Mar 13, 2025@21:13:58 Page 2
- LRARVER ;DALISC/CKA - LAB ARCHIVING VERIFY;8/25/95 ;10/2/95 09:12
- +1 ;;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
