XTPMKPP.m

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

XTPMKPP   ;OAK/BP - PATCH MONITOR PURGING;1/16/07

 +1       ;;7.3;TOOLKIT;**98,104**; Apr 25, 1995;Build 3

 +2       ;

EN         DO DT^DICRW

 +1       ; number of days to keep data in param file

 +2        SET XTBPDAYS=$PIECE($GET(^XPD(9.95,1,0)),U,2)

 +3       ; minimum of 30 days

           IF +XTBPDAYS=0

               SET XTBPDAYS=30

 +4        SET X1=DT

           SET X2=-XTBPDAYS

           DO C^%DTC

           SET XTBEND=X+.2359

           SET XTBX=""

 +5        FOR 

               SET XTBX=$ORDER(^XPD(9.9,"B",XTBX))

               IF XTBX=""

                   QUIT 

               FOR XTBDA=0:0

                   SET XTBDA=$ORDER(^XPD(9.9,"B",XTBX,XTBDA))

                   IF XTBDA=""

                       QUIT 

                   Begin DoDot:1

 +6                    SET XTBDTA=$GET(^XPD(9.9,XTBDA,0))

                       IF XTBDTA=""

                           QUIT 

 +7                    IF $PIECE(XTBDTA,U,10)

                           DO NONKID(XTBDA,XTBDTA,XTBEND)

                           QUIT 

 +8       ; install name

                       SET XTBINST=$PIECE(XTBDTA,U,8)

 +9       ; compliance date

                       SET XTBCMPDT=$PIECE(XTBDTA,U,9)

 +10                   SET XTBXX=$ORDER(^XPD(9.7,"B",XTBINST,"A"),-1)

                       IF +XTBXX'>0

                           QUIT 

 +11      ; not installed

                       IF $PIECE($GET(^XPD(9.7,+XTBXX,0)),U,9)'=3

                           QUIT 

 +12                   IF XTBCMPDT<XTBEND

                           SET DIK="^XPD(9.9,"

                           SET DA=XTBDA

                           DO ^DIK

                   End DoDot:1

 +13       KILL XTBPDAYS,X1,X2,XTBEND,XTBX,XTBXX,XTBDA,XTBCMPDT,DIK,DA,XTBINST,XTBDTA,X

 +14       QUIT 

NONKID(XTBDA,XTBDTA,XTBEND) ;Delete Non_Kid patches

 +1        NEW DA,DIK,XTNKB,XTNKBID,XTBCMPDT

 +2       ; compliance date

           SET XTBCMPDT=$PIECE(XTBDTA,U,9)

 +3       ; Non-Kids build

           SET XTNKB=$PIECE(XTBDTA,U,10)

 +4       ; Non-Kids build Install date

           SET XTNKBID=$PIECE(XTBDTA,U,11)

 +5        IF XTBCMPDT

               IF XTNKBID

                   IF XTBCMPDT<XTBEND

                       SET DIK="^XPD(9.9,"

                       SET DA=XTBDA

                       DO ^DIK

 +6        QUIT