Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: INHP

INHP.m

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