source: WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XTPMKPP.m@ 1474

Last change on this file since 1474 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.1 KB
RevLine 
[613]1XTPMKPP ;OAK/BP - PATCH MONITOR PURGING;1/16/07
2 ;;7.3;TOOLKIT;**98,104**; Apr 25, 1995;Build 3
3 ;
4EN D DT^DICRW
5 ; number of days to keep data in param file
6 S XTBPDAYS=$P($G(^XPD(9.95,1,0)),U,2)
7 I +XTBPDAYS=0 S XTBPDAYS=30 ; minimum of 30 days
8 S X1=DT,X2=-XTBPDAYS D C^%DTC S XTBEND=X+.2359,XTBX=""
9 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
10 .S XTBDTA=$G(^XPD(9.9,XTBDA,0)) Q:XTBDTA=""
11 .I $P(XTBDTA,U,10) D NONKID(XTBDA,XTBDTA,XTBEND) Q
12 .S XTBINST=$P(XTBDTA,U,8) ; install name
13 .S XTBCMPDT=$P(XTBDTA,U,9) ; compliance date
14 .S XTBXX=$O(^XPD(9.7,"B",XTBINST,"A"),-1) I +XTBXX'>0 Q
15 .Q:$P($G(^XPD(9.7,+XTBXX,0)),U,9)'=3 ; not installed
16 .I XTBCMPDT<XTBEND S DIK="^XPD(9.9,",DA=XTBDA D ^DIK
17 K XTBPDAYS,X1,X2,XTBEND,XTBX,XTBXX,XTBDA,XTBCMPDT,DIK,DA,XTBINST,XTBDTA,X
18 Q
19NONKID(XTBDA,XTBDTA,XTBEND) ;Delete Non_Kid patches
20 N DA,DIK,XTNKB,XTNKBID,XTBCMPDT
21 S XTBCMPDT=$P(XTBDTA,U,9) ; compliance date
22 S XTNKB=$P(XTBDTA,U,10) ; Non-Kids build
23 S XTNKBID=$P(XTBDTA,U,11) ; Non-Kids build Install date
24 I XTBCMPDT,XTNKBID,XTBCMPDT<XTBEND S DIK="^XPD(9.9,",DA=XTBDA D ^DIK
25 Q
Note: See TracBrowser for help on using the repository browser.