INHP ; FRW,JSH,BAR ; 4 Mar 98 14:57; Interface - Transaction/Error Purge
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
TPURGE ;Purge transactions from UIF
;Transactions with type: COMPLETE, ERROR, or NEGATIVE ACKNOWLEDGED can be purged
N TYPE,DAY,T,I,J,X,Y,%,INMAX,ZTSK,ZTDESC,ZTDTH,ZTRTN,ZTSAVE
I '$D(IOF) S (%ZIS,IOP)="" D ^%ZIS
W @IOF,?27,"*** Transaction Purge ***",!!
W "This option will create a background job which will purge transactions of the",!,"type indicated.",!!
S TYPE="",I=1 F W ! S X=$$SOC^UTIL("Select status of transactions to purge: ","","COMPLETE^ERROR^NEGATIVE ACKNOWLEDGED",0) Q:X=""!($E(X)="^") S X=$E(X) S:X="N" X="K" S:TYPE'[X I=I+1,$P(TYPE,U,I)=X
Q:$E(X)="^"!$G(DTOUT)
S TYPE=TYPE_U,DAY=$P($G(^INRHSITE(1,0)),U,11) S:'DAY DAY=14
W !! D ^UTSRD("Number of days to keep transactions: ;;;;"_DAY_";2,60","^D DHLP^INHP")
Q:X=""!($E(X)="^") S DAY=+X
; recap what they selected
W !!," All interface transactions before "_$$CDATASC^%ZTFDT($H-DAY,1)_" with the status of",!
S Y=$L(TYPE,U)-1 W " " F I=2:1:Y D
. S X=$P(TYPE,"^",I),X=$S(X="C":"COMPLETE",X="E":"ERROR",X="K":"NEGATIVE ACKNOWLEDGE",1:"")
. W $S(I=Y&(Y>2):" or ",1:"")_X_$S(I=Y!(Y<4):"",1:", ")
W " will be purged."
; note user with other purge info before they say OK
S INMAX=$P($G(^INRHSITE(1,0)),U,18)
I '$L(INMAX) W !!," Maximum days to keep any interface transaction is",!," not set and no additional purging will be done.",!
E W !!," All interface transactions older than "_$$CDATASC^%ZTFDT($H-INMAX,1)_" will be purged.",!
S X=$$YN^UTSRD("OK to proceed? ;1","") Q:'X
S ZTIO="",ZTRTN="ZTSK^INHP" F I="DAY","TYPE" S ZTSAVE(I)=""
S ZTDESC="Purge GIS Messages" D ^%ZTLOAD W !,"Request",$S($G(ZTSK):" ",1:" NOT "),"QUEUED!" K ZTSK
Q
;
ZTSK ;Taskman entry point
;DAY = number of days to keep transactions
;TYPE = status(es) of message to purge
; C = complete, E = error, K = Negative Acknowledge
; TYPE can contain more than one of these letters separated by ^
; for example, to purge types E and C set TYPE="E^C"
;
;Do misc cleanup
D MISC
;
N INTYPE,INDAY,INCOUNT,INMAX,INDT,DIK
S INTYPE=TYPE,INDAY=DAY,INCOUNT=0
D SETDT^UTDT S X1=DT,X2=-DAY D C^%DTC S INDAY=X
; get max days for transactions, calc date if filled in
S INMAX=$P($G(^INRHSITE(1,0)),U,18)
I $L(INMAX) S X1=DT,X2=-INMAX D C^%DTC S INMAX=X
;Loop through file
S INX=0 F S INX=$O(^INTHU(INX)) Q:'INX D
. I '$L($G(^INTHU(INX,0))) K ^INTHU(INX) Q ;SHOULD ALSO LOG ERROR
. S INDT=$P(^INTHU(INX,0),U,14)
. ; purge all transactions after certain date
. I (+^INTHU(INX,0))<INMAX S DA=INX,DIK="^INTHU(" D ^DIK,HANG Q
. I INDT<INDAY,INTYPE[(U_$P(^INTHU(INX,0),U,3)_U) S DA=INX,DIK="^INTHU(" D ^DIK,HANG
Q
;
HANG ;Limit entries deleted to 21000/hour
S INCOUNT=INCOUNT+1 Q:INCOUNT<6
S INCOUNT=0 H 1
Q
;
MISC ;Misc cleanup
;Purge save global for postmaster
K ^DIJUSV(.5)
;Purge message search file
S %=$$CPURG()
;
;CLEAN UP ANY OLD (10 days?) ^UTILITY GLOBAL SUBSCRIPTS FOR THE GIS
; - ^UTILITY("INSAVE" , description , $H )
; - TRANSACTION TYPE MOVER
; - TEST DRIVER (^UTILITY("INTHU")) - maybe not
;
Q
;
DHLP ;Help for # of days question
W !,"This is the number of days that must have passed since the last activity",!,"on a transaction has occurred. For example, entering a value of 3 here will"
W !,"cause any transactions whose last activity was 4 or more days ago to be purged.",!!,"You may enter a number from 2 to 60."
W ! Q
;
DEHLP ;Help for days to keep errors question
W !,"This is the number of days that must have passed since the error was logged",!,"in order for it to be purged. For example, entering a value of 3 here will"
W !,"cause any errors that were created more than 4 days ago to be deleted.",!!,"You may enter a number from 2 to 60.",! Q
;
EPURGE ;Purge Interface Errors
N TYPE,DAY,T,I,J,X,%,ZTSK
I '$D(IOF) S (%ZIS,IOP)="" D ^%ZIS
W @IOF,?30,"*** Error Purge ***",!!
W "This option will create a background job which will purge Interface Errors",!,"older than the number of days specified."
W !! D ^UTSRD("Number of days to keep errors: ;;;;14;2,60","^D DEHLP^INHP")
Q:X=""!($E(X)="^")
S DAY=+X,X=$$YN^UTSRD("OK to proceed? ;1","") Q:'X
S ZTIO="",ZTRTN="EZTSK^INHP",ZTDESC="Purge GIS Errors",ZTSAVE("DAY")="" D ^%ZTLOAD W !,"Request QUEUED!" K ZTSK Q
;
EZTSK ;Taskman can enter here with DAY=# of days to keep errors
D SETDT^UTDT S X1=DT,X2=-DAY D C^%DTC S DAY=X
S DIK="^INTHER(",INX="",INCOUNT=0
F S INX=$O(^INTHER("B",INX)) Q:'INX!(INX'<DAY) S DA=0 F S DA=$O(^INTHER("B",INX,DA)) Q:'DA D ^DIK,HANG
Q
;
CPURG() ;Purge aged entries from Interface Criteria File, #4001.1
; returns: 1 - Purge completed
N INDA,INGL,INPDT,INX
S INGL="^DIZ(4001.1)"
; get date to purge to. TODAY - CRITERIA RETENSION DAYS
S INPDT=$P($G(^INRHSITE(1,0)),U,17),INPDT=$$RELDT^INHUTC2("T-"_$S('$L(INPDT):180,1:INPDT))
S INDA=0 F S INDA=$O(@INGL@(INDA)) Q:'INDA D
. ; get zero node data
. S INX=$G(@INGL@(INDA,0))
. ; bkgrd entry, do not remove if task exists, set dete to 0 to purge
. I $P(INX,U,3)="B" Q:$D(^%ZTSK(+$P(INX,U,7),0)) S $P(INX,U,9)=0
. ;check for standard entry or date of last access GT purge date
. Q:$P(INX,U,3)="S"!($P(INX,U,9)'<INPDT)
. ;kill entry
. S %=$$DELCRIT^INHUTC(INDA)
Q 1
;
AUTO ;Autopurge of transactions and errors
N DAY,TYPE
S TYPE="^C^E^K^",DAY=$P(^INRHSITE(1,0),U,11) Q:'DAY
D ZTSK
S DAY=$P(^INRHSITE(1,0),U,11) Q:'DAY
D EZTSK
Q
INHP ; FRW,JSH,BAR ; 4 Mar 98 14:57; Interface - Transaction/Error Purge
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
TPURGE ;Purge transactions from UIF
+1 ;Transactions with type: COMPLETE, ERROR, or NEGATIVE ACKNOWLEDGED can be purged
+2 NEW TYPE,DAY,T,I,J,X,Y,%,INMAX,ZTSK,ZTDESC,ZTDTH,ZTRTN,ZTSAVE
+3 IF '$DATA(IOF)
SET (%ZIS,IOP)=""
DO ^%ZIS
+4 WRITE @IOF,?27,"*** Transaction Purge ***",!!
+5 WRITE "This option will create a background job which will purge transactions of the",!,"type indicated.",!!
+6 SET TYPE=""
SET I=1
FOR
WRITE !
SET X=$$SOC^UTIL("Select status of transactions to purge: ","","COMPLETE^ERROR^NEGATIVE ACKNOWLEDGED",0)
IF X=""!($EXTRACT(X)="^")
QUIT
SET X=$EXTRACT(X)
IF X="N"
SET X="K"
IF TYPE'[X
SET I=I+1
SET $PIECE(TYPE,U,I)=X
+7 IF $EXTRACT(X)="^"!$GET(DTOUT)
QUIT
+8 SET TYPE=TYPE_U
SET DAY=$PIECE($GET(^INRHSITE(1,0)),U,11)
IF 'DAY
SET DAY=14
+9 WRITE !!
DO ^UTSRD("Number of days to keep transactions: ;;;;"_DAY_";2,60","^D DHLP^INHP")
+10 IF X=""!($EXTRACT(X)="^")
QUIT
SET DAY=+X
+11 ; recap what they selected
+12 WRITE !!," All interface transactions before "_$$CDATASC^%ZTFDT($HOROLOG-DAY,1)_" with the status of",!
+13 SET Y=$LENGTH(TYPE,U)-1
WRITE " "
FOR I=2:1:Y
Begin DoDot:1
+14 SET X=$PIECE(TYPE,"^",I)
SET X=$SELECT(X="C":"COMPLETE",X="E":"ERROR",X="K":"NEGATIVE ACKNOWLEDGE",1:"")
+15 WRITE $SELECT(I=Y&(Y>2):" or ",1:"")_X_$SELECT(I=Y!(Y<4):"",1:", ")
End DoDot:1
+16 WRITE " will be purged."
+17 ; note user with other purge info before they say OK
+18 SET INMAX=$PIECE($GET(^INRHSITE(1,0)),U,18)
+19 IF '$LENGTH(INMAX)
WRITE !!," Maximum days to keep any interface transaction is",!," not set and no additional purging will be done.",!
+20 IF '$TEST
WRITE !!," All interface transactions older than "_$$CDATASC^%ZTFDT($HOROLOG-INMAX,1)_" will be purged.",!
+21 SET X=$$YN^UTSRD("OK to proceed? ;1","")
IF 'X
QUIT
+22 SET ZTIO=""
SET ZTRTN="ZTSK^INHP"
FOR I="DAY","TYPE"
SET ZTSAVE(I)=""
+23 SET ZTDESC="Purge GIS Messages"
DO ^%ZTLOAD
WRITE !,"Request",$SELECT($GET(ZTSK):" ",1:" NOT "),"QUEUED!"
KILL ZTSK
+24 QUIT
+25 ;
ZTSK ;Taskman entry point
+1 ;DAY = number of days to keep transactions
+2 ;TYPE = status(es) of message to purge
+3 ; C = complete, E = error, K = Negative Acknowledge
+4 ; TYPE can contain more than one of these letters separated by ^
+5 ; for example, to purge types E and C set TYPE="E^C"
+6 ;
+7 ;Do misc cleanup
+8 DO MISC
+9 ;
+10 NEW INTYPE,INDAY,INCOUNT,INMAX,INDT,DIK
+11 SET INTYPE=TYPE
SET INDAY=DAY
SET INCOUNT=0
+12 DO SETDT^UTDT
SET X1=DT
SET X2=-DAY
DO C^%DTC
SET INDAY=X
+13 ; get max days for transactions, calc date if filled in
+14 SET INMAX=$PIECE($GET(^INRHSITE(1,0)),U,18)
+15 IF $LENGTH(INMAX)
SET X1=DT
SET X2=-INMAX
DO C^%DTC
SET INMAX=X
+16 ;Loop through file
+17 SET INX=0
FOR
SET INX=$ORDER(^INTHU(INX))
IF 'INX
QUIT
Begin DoDot:1
+18 ;SHOULD ALSO LOG ERROR
IF '$LENGTH($GET(^INTHU(INX,0)))
KILL ^INTHU(INX)
QUIT
+19 SET INDT=$PIECE(^INTHU(INX,0),U,14)
+20 ; purge all transactions after certain date
+21 IF (+^INTHU(INX,0))<INMAX
SET DA=INX
SET DIK="^INTHU("
DO ^DIK
DO HANG
QUIT
+22 IF INDT<INDAY
IF INTYPE[(U_$PIECE(^INTHU(INX,0),U,3)_U)
SET DA=INX
SET DIK="^INTHU("
DO ^DIK
DO HANG
End DoDot:1
+23 QUIT
+24 ;
HANG ;Limit entries deleted to 21000/hour
+1 SET INCOUNT=INCOUNT+1
IF INCOUNT<6
QUIT
+2 SET INCOUNT=0
HANG 1
+3 QUIT
+4 ;
MISC ;Misc cleanup
+1 ;Purge save global for postmaster
+2 KILL ^DIJUSV(.5)
+3 ;Purge message search file
+4 SET %=$$CPURG()
+5 ;
+6 ;CLEAN UP ANY OLD (10 days?) ^UTILITY GLOBAL SUBSCRIPTS FOR THE GIS
+7 ; - ^UTILITY("INSAVE" , description , $H )
+8 ; - TRANSACTION TYPE MOVER
+9 ; - TEST DRIVER (^UTILITY("INTHU")) - maybe not
+10 ;
+11 QUIT
+12 ;
DHLP ;Help for # of days question
+1 WRITE !,"This is the number of days that must have passed since the last activity",!,"on a transaction has occurred. For example, entering a value of 3 here will"
+2 WRITE !,"cause any transactions whose last activity was 4 or more days ago to be purged.",!!,"You may enter a number from 2 to 60."
+3 WRITE !
QUIT
+4 ;
DEHLP ;Help for days to keep errors question
+1 WRITE !,"This is the number of days that must have passed since the error was logged",!,"in order for it to be purged. For example, entering a value of 3 here will"
+2 WRITE !,"cause any errors that were created more than 4 days ago to be deleted.",!!,"You may enter a number from 2 to 60.",!
QUIT
+3 ;
EPURGE ;Purge Interface Errors
+1 NEW TYPE,DAY,T,I,J,X,%,ZTSK
+2 IF '$DATA(IOF)
SET (%ZIS,IOP)=""
DO ^%ZIS
+3 WRITE @IOF,?30,"*** Error Purge ***",!!
+4 WRITE "This option will create a background job which will purge Interface Errors",!,"older than the number of days specified."
+5 WRITE !!
DO ^UTSRD("Number of days to keep errors: ;;;;14;2,60","^D DEHLP^INHP")
+6 IF X=""!($EXTRACT(X)="^")
QUIT
+7 SET DAY=+X
SET X=$$YN^UTSRD("OK to proceed? ;1","")
IF 'X
QUIT
+8 SET ZTIO=""
SET ZTRTN="EZTSK^INHP"
SET ZTDESC="Purge GIS Errors"
SET ZTSAVE("DAY")=""
DO ^%ZTLOAD
WRITE !,"Request QUEUED!"
KILL ZTSK
QUIT
+9 ;
EZTSK ;Taskman can enter here with DAY=# of days to keep errors
+1 DO SETDT^UTDT
SET X1=DT
SET X2=-DAY
DO C^%DTC
SET DAY=X
+2 SET DIK="^INTHER("
SET INX=""
SET INCOUNT=0
+3 FOR
SET INX=$ORDER(^INTHER("B",INX))
IF 'INX!(INX'<DAY)
QUIT
SET DA=0
FOR
SET DA=$ORDER(^INTHER("B",INX,DA))
IF 'DA
QUIT
DO ^DIK
DO HANG
+4 QUIT
+5 ;
CPURG() ;Purge aged entries from Interface Criteria File, #4001.1
+1 ; returns: 1 - Purge completed
+2 NEW INDA,INGL,INPDT,INX
+3 SET INGL="^DIZ(4001.1)"
+4 ; get date to purge to. TODAY - CRITERIA RETENSION DAYS
+5 SET INPDT=$PIECE($GET(^INRHSITE(1,0)),U,17)
SET INPDT=$$RELDT^INHUTC2("T-"_$SELECT('$LENGTH(INPDT):180,1:INPDT))
+6 SET INDA=0
FOR
SET INDA=$ORDER(@INGL@(INDA))
IF 'INDA
QUIT
Begin DoDot:1
+7 ; get zero node data
+8 SET INX=$GET(@INGL@(INDA,0))
+9 ; bkgrd entry, do not remove if task exists, set dete to 0 to purge
+10 IF $PIECE(INX,U,3)="B"
IF $DATA(^%ZTSK(+$PIECE(INX,U,7),0))
QUIT
SET $PIECE(INX,U,9)=0
+11 ;check for standard entry or date of last access GT purge date
+12 IF $PIECE(INX,U,3)="S"!($PIECE(INX,U,9)'<INPDT)
QUIT
+13 ;kill entry
+14 SET %=$$DELCRIT^INHUTC(INDA)
End DoDot:1
+15 QUIT 1
+16 ;
AUTO ;Autopurge of transactions and errors
+1 NEW DAY,TYPE
+2 SET TYPE="^C^E^K^"
SET DAY=$PIECE(^INRHSITE(1,0),U,11)
IF 'DAY
QUIT
+3 DO ZTSK
+4 SET DAY=$PIECE(^INRHSITE(1,0),U,11)
IF 'DAY
QUIT
+5 DO EZTSK
+6 QUIT
