LRARIPRE.m

LRARIPRE ; IHS/DIR/AAB - LRAR PRE INIT DELETE ARCHIVED FILES ;

 ;;5.2;LR;**1002**;JUN 01, 1998

 ;;5.2;LAB SERVICE;**59**;August 9, 1995

EN ;

 W !!,">>> Deleting OLD 'LAB' ARCHIVE FILES.",!

AWD W !!,"DELETING ARCHIVED WKLD DATA FILE."

 S DIU="^LRO(64.19999,",DIU(0)="D" D EN^DIU2

ALM W !!,"DELETING ARCHIVED LAB MONTHLY WORKLOADS FILE."

 S DIU="^LRO(67.99999,",DIU(0)="D" D EN^DIU2

ABI W !!,"DELETING ARCHIVED BLOOD INVENTORY FILE."

 S DIU="^LRD(65.9999,",DIU(0)="D" D EN^DIU2

 K DIU

 W !!,"The data dictionaries for these files will be reinstalled during the inits."

 Q

BXREF ;Kills B xref on PATIENT XMATCH field (#65.01)

 ;This xref is in the DD's but not the file.

 Q:'$D(^DD(65.01,0,"IX","B",65.01,.01))  ;already deleted

 S LRARI=0 F  S LRARI=$O(^DD(65.01,.01,1,LRARI)) Q:'LRARI  D

 . K:$G(^DD(65.01,.01,1,LRARI,0))="65.01^B" ^DD(65.01,.01,1,LRARI)

 K ^DD(65.01,0,"IX","B",65.01,.01)

 K:'$O(^DD(65.01,.01,1,0)) ^DD(65.01,"IX",.01) ;no xrefs left on field

 Q

LRARIPRE  ; IHS/DIR/AAB - LRAR PRE INIT DELETE ARCHIVED FILES ;

 +1       ;;5.2;LR;**1002**;JUN 01, 1998

 +2       ;;5.2;LAB SERVICE;**59**;August 9, 1995

EN        ;

 +1        WRITE !!,">>> Deleting OLD 'LAB' ARCHIVE FILES.",!

AWD        WRITE !!,"DELETING ARCHIVED WKLD DATA FILE."

 +1        SET DIU="^LRO(64.19999,"

           SET DIU(0)="D"

           DO EN^DIU2

ALM        WRITE !!,"DELETING ARCHIVED LAB MONTHLY WORKLOADS FILE."

 +1        SET DIU="^LRO(67.99999,"

           SET DIU(0)="D"

           DO EN^DIU2

ABI        WRITE !!,"DELETING ARCHIVED BLOOD INVENTORY FILE."

 +1        SET DIU="^LRD(65.9999,"

           SET DIU(0)="D"

           DO EN^DIU2

 +2        KILL DIU

 +3        WRITE !!,"The data dictionaries for these files will be reinstalled during the inits."

 +4        QUIT 

BXREF     ;Kills B xref on PATIENT XMATCH field (#65.01)

 +1       ;This xref is in the DD's but not the file.

 +2       ;already deleted

           IF '$DATA(^DD(65.01,0,"IX","B",65.01,.01))

               QUIT 

 +3        SET LRARI=0

           FOR 

               SET LRARI=$ORDER(^DD(65.01,.01,1,LRARI))

               IF 'LRARI

                   QUIT 

               Begin DoDot:1

 +4                IF $GET(^DD(65.01,.01,1,LRARI,0))="65.01^B"

                       KILL ^DD(65.01,.01,1,LRARI)

               End DoDot:1

 +5        KILL ^DD(65.01,0,"IX","B",65.01,.01)

 +6       ;no xrefs left on field

           IF '$ORDER(^DD(65.01,.01,1,0))

               KILL ^DD(65.01,"IX",.01)

 +7        QUIT