26 lines
1.1 KiB
Mathematica
26 lines
1.1 KiB
Mathematica
XTPMKPP ;OAK/BP - PATCH MONITOR PURGING;1/16/07
|
|
;;7.3;TOOLKIT;**98,104**; Apr 25, 1995;Build 3
|
|
;
|
|
EN D DT^DICRW
|
|
; number of days to keep data in param file
|
|
S XTBPDAYS=$P($G(^XPD(9.95,1,0)),U,2)
|
|
I +XTBPDAYS=0 S XTBPDAYS=30 ; minimum of 30 days
|
|
S X1=DT,X2=-XTBPDAYS D C^%DTC S XTBEND=X+.2359,XTBX=""
|
|
F S XTBX=$O(^XPD(9.9,"B",XTBX)) Q:XTBX="" F XTBDA=0:0 S XTBDA=$O(^XPD(9.9,"B",XTBX,XTBDA)) Q:XTBDA="" DO
|
|
.S XTBDTA=$G(^XPD(9.9,XTBDA,0)) Q:XTBDTA=""
|
|
.I $P(XTBDTA,U,10) D NONKID(XTBDA,XTBDTA,XTBEND) Q
|
|
.S XTBINST=$P(XTBDTA,U,8) ; install name
|
|
.S XTBCMPDT=$P(XTBDTA,U,9) ; compliance date
|
|
.S XTBXX=$O(^XPD(9.7,"B",XTBINST,"A"),-1) I +XTBXX'>0 Q
|
|
.Q:$P($G(^XPD(9.7,+XTBXX,0)),U,9)'=3 ; not installed
|
|
.I XTBCMPDT<XTBEND S DIK="^XPD(9.9,",DA=XTBDA D ^DIK
|
|
K XTBPDAYS,X1,X2,XTBEND,XTBX,XTBXX,XTBDA,XTBCMPDT,DIK,DA,XTBINST,XTBDTA,X
|
|
Q
|
|
NONKID(XTBDA,XTBDTA,XTBEND) ;Delete Non_Kid patches
|
|
N DA,DIK,XTNKB,XTNKBID,XTBCMPDT
|
|
S XTBCMPDT=$P(XTBDTA,U,9) ; compliance date
|
|
S XTNKB=$P(XTBDTA,U,10) ; Non-Kids build
|
|
S XTNKBID=$P(XTBDTA,U,11) ; Non-Kids build Install date
|
|
I XTBCMPDT,XTNKBID,XTBCMPDT<XTBEND S DIK="^XPD(9.9,",DA=XTBDA D ^DIK
|
|
Q
|