BLRALAC ;DAOU/ALA-Archive/Purge Lab Audit ;[ 12/19/2002 7:13 AM ]
;;5.2;LR;**1013,1015**;NOV 18, 2002
;
;**PROGRAM DESCRIPTION**
; This program will archive and purge lab audit data.
;
EN ; Determine archive filename,path, and last date run
; Check for parameters in Audit sub-file, if null QUIT.
I '$D(^BLRALAB(9009027.2,1,0)) G EXIT
I $P($G(^BLRALAB(9009027.2,1,0)),U,2)<1 G EXIT
S BLRAPTH=$P($G(^BLRALAB(9009027.2,1,0)),U,4) I BLRAPTH="" G EXIT
S BLRADAYS=$P($G(^BLRALAB(9009027.2,1,0)),U,3)
I BLRADAYS="" S BLRADAYS=7
S BLRAEDT=$$FMADD^XLFDT($$DT^XLFDT(),-BLRADAYS)
S BLRADT=$$HLDATE^HLFNC($$DT^XLFDT())
S BLRANME="BLRA"_BLRADT_".txt"
K ^TMP($J,"BLRA"),^TMP("BLRZ",$J)
;------------------------------------------------------------
DDD ;DATE PORTION OF ROUTINE
S DDD1="",PID1=""
F S DDD1=$O(^BLRALAB(9009027,"B",DDD1)) Q:DDD1\1>BLRAEDT!(DDD1="") D
. F S PID1=$O(^BLRALAB(9009027,"B",DDD1,PID1)) Q:PID1="" D
.. D GETS^DIQ(9009027,PID1,"*","R","^TMP(""BLRZ"",$J","ERR")
;THE AFOREMENTIONED CODE LOOPS THRU GLOBAL ^BLRALAB GETS ALL NODES
;OF THE DATA AND STORES THEM IN A TEMP GLOBAL ^TMP
;------------------------------------------------------------
FIL ; Set file
S BGLOB="^TMP(""BLRZ"",$J,9009027)"
S BLRAY=$$OPEN^%ZISH(BLRAPTH,BLRANME,"A") I BLRAY=1 W !!,"Unable to open Host File Server to create archive file" Q
U IO W "ACCESSION#^DATE/TIME STAMP^MENU OPTION^PATIENT^USER"
S IEN="" F S IEN=$O(@BGLOB@(IEN)) Q:'IEN D
. U IO W ! S FLD="" F S FLD=$O(@BGLOB@(IEN,FLD)) Q:FLD="" D
.. U IO W @BGLOB@(IEN,FLD),"^"
U IO W ! D CLOSE^%ZISH(BLRAY)
S $P(^BLRALAB(9009027.2,1,0),U,5)=$$NOW^XLFDT()
;------------------------------------------------------------
DEL ; Delete Records by date
K DA,DIK
S BDTM=""
S DIK="^BLRALAB(9009027,"
F S BDTM=$O(^BLRALAB(9009027,"B",BDTM)) Q:BDTM\1>BLRAEDT!(BDTM="") D
. S DA="",DA(1)=BDTM
. F S DA=$O(^BLRALAB(9009027,"B",BDTM,DA)) Q:'DA D ^DIK
;-----------------------------------------------------------
EXIT K BLRADT,BLRANME,BLRAPTH,DIR,Y,X,DIK,DA,IEN,%DT
K BLRAY,BGLOB,FLD,DDD1,PID1,DIC,BDTM,BLRAEDT
K ^TMP("BLRZ",$J),^TMP($J,"BLRAUSC"),^TMP($J,"BLRAU")
Q
;
EN2 ;EP
;
; This sub-routine will allow the site manager to setup
; the Lab ESIG Audit Parameters.
;
N Y,BLRAFIL
K DIC,DIE,DIR,DA,DR
; Find the Lab ESIG Audit Record
W @IOF
S DIC="^BLRALAB(9009027.2,"
S DIC(0)="AELMQO"
D ^DIC
I Y<1 Q
; Display the current parameters
S DA=$P($G(Y),U)
S BLRAFIL=$$EXTERNAL^DILFD(9009027.2,.01,"",$P($G(Y),U,2))
D EN^DDIOL("","","!!")
D EN^DDIOL("THE CURRENT LAB ESIG PARAMETERS ARE:","","!")
S DR=0 D EN^DIQ
; Allow to edit parameters
S DIR(0)="Y"
S DIR("A")="Would you like to edit these parameters "
S DIR("B")="YES"
D ^DIR
I Y S DIE=DIC,DR="[BLRA AUDIT PARAMETERS]" D ^DIE
I $$GET1^DIQ(9009027.2,DA,.02,"I")<1 D
. D EN^DDIOL(" *** THE LAB ESIG AUDITING AND ARCHIVING IS TURNED OFF ***","","!!!")
. D EN^DDIOL(" *** PLEASE UNSCHEDULE THE 'BLRA LAB ARCHIVE' OPTION IN TASKMAN ***","","!")
E D
. D EN^DDIOL(" *** THE LAB ESIG AUDITING AND ARCHIVING IS TURNED ON ***","","!!!")
. D EN^DDIOL(" *** PLEASE SCHEDULE THE 'BLRA LAB ARCHIVE' OPTION IN TASKMAN ***","","!")
D EN^DDIOL("","","!!!!")
K DIE,DIC,DIR,DR,DA
Q
;
FORM ;EP - Check format of directory pathname
;
S BLRAMVER=$$VERSION^%ZOSV(1)
I BLRAMVER["UNIX" D
. I X["\"!($E(X,1,1)'="/")!($E(X,$L(X),$L(X))'="/") K X D
.. D EN^DDIOL("*** INCORRECT DIRECTORY PATHNAME! ***","","!!")
E D
. I X["/"!($E(X,1,1)'?.A)!($E(X,2,2)'=":")!($E(X,3,3)'="\") K X D
.. D EN^DDIOL("*** INCORRECT DIRECTORY PATHNAME! ***","","!!")
K BLRAMVER
Q
KILLX ; EP
S BLRAMVER=$$VERSION^%ZOSV(1)
I BLRAMVER["UNIX" D
. D EN^DDIOL("Enter UNIX directory pathnames in the following format: /usr3/IHS/RPMS0/","","!")
E D
. D EN^DDIOL("Enter NT directory pathnames in the following format: C:\","","!")
K BLRAMVER
Q
BLRALAC ;DAOU/ALA-Archive/Purge Lab Audit ;[ 12/19/2002 7:13 AM ]
+1 ;;5.2;LR;**1013,1015**;NOV 18, 2002
+2 ;
+3 ;**PROGRAM DESCRIPTION**
+4 ; This program will archive and purge lab audit data.
+5 ;
EN ; Determine archive filename,path, and last date run
+1 ; Check for parameters in Audit sub-file, if null QUIT.
+2 IF '$DATA(^BLRALAB(9009027.2,1,0))
GOTO EXIT
+3 IF $PIECE($GET(^BLRALAB(9009027.2,1,0)),U,2)<1
GOTO EXIT
+4 SET BLRAPTH=$PIECE($GET(^BLRALAB(9009027.2,1,0)),U,4)
IF BLRAPTH=""
GOTO EXIT
+5 SET BLRADAYS=$PIECE($GET(^BLRALAB(9009027.2,1,0)),U,3)
+6 IF BLRADAYS=""
SET BLRADAYS=7
+7 SET BLRAEDT=$$FMADD^XLFDT($$DT^XLFDT(),-BLRADAYS)
+8 SET BLRADT=$$HLDATE^HLFNC($$DT^XLFDT())
+9 SET BLRANME="BLRA"_BLRADT_".txt"
+10 KILL ^TMP($JOB,"BLRA"),^TMP("BLRZ",$JOB)
+11 ;------------------------------------------------------------
DDD ;DATE PORTION OF ROUTINE
+1 SET DDD1=""
SET PID1=""
+2 FOR
SET DDD1=$ORDER(^BLRALAB(9009027,"B",DDD1))
IF DDD1\1>BLRAEDT!(DDD1="")
QUIT
Begin DoDot:1
+3 FOR
SET PID1=$ORDER(^BLRALAB(9009027,"B",DDD1,PID1))
IF PID1=""
QUIT
Begin DoDot:2
+4 DO GETS^DIQ(9009027,PID1,"*","R","^TMP(""BLRZ"",$J","ERR")
End DoDot:2
End DoDot:1
+5 ;THE AFOREMENTIONED CODE LOOPS THRU GLOBAL ^BLRALAB GETS ALL NODES
+6 ;OF THE DATA AND STORES THEM IN A TEMP GLOBAL ^TMP
+7 ;------------------------------------------------------------
FIL ; Set file
+1 SET BGLOB="^TMP(""BLRZ"",$J,9009027)"
+2 SET BLRAY=$$OPEN^%ZISH(BLRAPTH,BLRANME,"A")
IF BLRAY=1
WRITE !!,"Unable to open Host File Server to create archive file"
QUIT
+3 USE IO
WRITE "ACCESSION#^DATE/TIME STAMP^MENU OPTION^PATIENT^USER"
+4 SET IEN=""
FOR
SET IEN=$ORDER(@BGLOB@(IEN))
IF 'IEN
QUIT
Begin DoDot:1
+5 USE IO
WRITE !
SET FLD=""
FOR
SET FLD=$ORDER(@BGLOB@(IEN,FLD))
IF FLD=""
QUIT
Begin DoDot:2
+6 USE IO
WRITE @BGLOB@(IEN,FLD),"^"
End DoDot:2
End DoDot:1
+7 USE IO
WRITE !
DO CLOSE^%ZISH(BLRAY)
+8 SET $PIECE(^BLRALAB(9009027.2,1,0),U,5)=$$NOW^XLFDT()
+9 ;------------------------------------------------------------
DEL ; Delete Records by date
+1 KILL DA,DIK
+2 SET BDTM=""
+3 SET DIK="^BLRALAB(9009027,"
+4 FOR
SET BDTM=$ORDER(^BLRALAB(9009027,"B",BDTM))
IF BDTM\1>BLRAEDT!(BDTM="")
QUIT
Begin DoDot:1
+5 SET DA=""
SET DA(1)=BDTM
+6 FOR
SET DA=$ORDER(^BLRALAB(9009027,"B",BDTM,DA))
IF 'DA
QUIT
DO ^DIK
End DoDot:1
+7 ;-----------------------------------------------------------
EXIT KILL BLRADT,BLRANME,BLRAPTH,DIR,Y,X,DIK,DA,IEN,%DT
+1 KILL BLRAY,BGLOB,FLD,DDD1,PID1,DIC,BDTM,BLRAEDT
+2 KILL ^TMP("BLRZ",$JOB),^TMP($JOB,"BLRAUSC"),^TMP($JOB,"BLRAU")
+3 QUIT
+4 ;
EN2 ;EP
+1 ;
+2 ; This sub-routine will allow the site manager to setup
+3 ; the Lab ESIG Audit Parameters.
+4 ;
+5 NEW Y,BLRAFIL
+6 KILL DIC,DIE,DIR,DA,DR
+7 ; Find the Lab ESIG Audit Record
+8 WRITE @IOF
+9 SET DIC="^BLRALAB(9009027.2,"
+10 SET DIC(0)="AELMQO"
+11 DO ^DIC
+12 IF Y<1
QUIT
+13 ; Display the current parameters
+14 SET DA=$PIECE($GET(Y),U)
+15 SET BLRAFIL=$$EXTERNAL^DILFD(9009027.2,.01,"",$PIECE($GET(Y),U,2))
+16 DO EN^DDIOL("","","!!")
+17 DO EN^DDIOL("THE CURRENT LAB ESIG PARAMETERS ARE:","","!")
+18 SET DR=0
DO EN^DIQ
+19 ; Allow to edit parameters
+20 SET DIR(0)="Y"
+21 SET DIR("A")="Would you like to edit these parameters "
+22 SET DIR("B")="YES"
+23 DO ^DIR
+24 IF Y
SET DIE=DIC
SET DR="[BLRA AUDIT PARAMETERS]"
DO ^DIE
+25 IF $$GET1^DIQ(9009027.2,DA,.02,"I")<1
Begin DoDot:1
+26 DO EN^DDIOL(" *** THE LAB ESIG AUDITING AND ARCHIVING IS TURNED OFF ***","","!!!")
+27 DO EN^DDIOL(" *** PLEASE UNSCHEDULE THE 'BLRA LAB ARCHIVE' OPTION IN TASKMAN ***","","!")
End DoDot:1
+28 IF '$TEST
Begin DoDot:1
+29 DO EN^DDIOL(" *** THE LAB ESIG AUDITING AND ARCHIVING IS TURNED ON ***","","!!!")
+30 DO EN^DDIOL(" *** PLEASE SCHEDULE THE 'BLRA LAB ARCHIVE' OPTION IN TASKMAN ***","","!")
End DoDot:1
+31 DO EN^DDIOL("","","!!!!")
+32 KILL DIE,DIC,DIR,DR,DA
+33 QUIT
+34 ;
FORM ;EP - Check format of directory pathname
+1 ;
+2 SET BLRAMVER=$$VERSION^%ZOSV(1)
+3 IF BLRAMVER["UNIX"
Begin DoDot:1
+4 IF X["\"!($EXTRACT(X,1,1)'="/")!($EXTRACT(X,$LENGTH(X),$LENGTH(X))'="/")
KILL X
Begin DoDot:2
+5 DO EN^DDIOL("*** INCORRECT DIRECTORY PATHNAME! ***","","!!")
End DoDot:2
End DoDot:1
+6 IF '$TEST
Begin DoDot:1
+7 IF X["/"!($EXTRACT(X,1,1)'?.A)!($EXTRACT(X,2,2)'=":")!($EXTRACT(X,3,3)'="\")
KILL X
Begin DoDot:2
+8 DO EN^DDIOL("*** INCORRECT DIRECTORY PATHNAME! ***","","!!")
End DoDot:2
End DoDot:1
+9 KILL BLRAMVER
+10 QUIT
KILLX ; EP
+1 SET BLRAMVER=$$VERSION^%ZOSV(1)
+2 IF BLRAMVER["UNIX"
Begin DoDot:1
+3 DO EN^DDIOL("Enter UNIX directory pathnames in the following format: /usr3/IHS/RPMS0/","","!")
End DoDot:1
+4 IF '$TEST
Begin DoDot:1
+5 DO EN^DDIOL("Enter NT directory pathnames in the following format: C:\","","!")
End DoDot:1
+6 KILL BLRAMVER
+7 QUIT
