XTPMKPTC ;OAK/BP - PATCH MONITOR FUNCTIONS ;09/10/2008
;;7.3;TOOLKIT;**98,100,114**; Apr 25, 1995;Build 5
;;Per VHA Directive 2004-038, this routine should not be modified.
;
SRVR N XMB X XMREC
S XTBMLN1=$G(^XMB(3.9,XMZ,0))
I XTBMLN1["COMPLIANCE DATE CHANGE" G CKCMPDT
;
CHECK I XTBMLN1["TEST" G EXIT
I XTBMLN1["COMPLIANCE DATE CHANGE" G CKCMPDT
I XTBMLN1["Entered in error patch" DO I $D(OUT) K OUT G EXIT
.F XTBX=1:1:8 S XTBY=$G(^XMB(3.9,XMZ,2,+XTBX,0)) I XTBY["The patch is" DO Q:$D(OUT)
..K OUT S X=$P(XTBY,"'",2),DIC(0)="QLM",DIC="^XPD(9.9," D ^DIC I Y<0 S OUT=1 Q
..S DIK=DIC,DA=+Y D ^DIK K DIC,DIK,DA,XTBX,XTBY,Y,X S OUT=1 Q
I XTBMLN1'["SEQ #"!(XTBMLN1'["National Patch Module") G EXIT
;
CKCMPDT D CMPDTCG^XTPMKPCF I $D(XTBCMDCG) K XTBCMDCG G EXIT ;compliance date chg check
S XTBPTYPE=1 ;assume NON-KIDS until verified
F XTBX=0:0 S XTBX=$O(^XMB(3.9,XMZ,2,XTBX)) Q:XTBX=""!(+XTBX=0) S XTBY=$G(^XMB(3.9,XMZ,2,XTBX,0)) I XTBY["$KID" DO
.S XTBZ=$O(^XMB(3.9,XMZ,2,XTBX)) I $G(^XMB(3.9,XMZ,2,XTBZ,0))["**INSTALL NAME**" S XTBPTYPE="",XTBX=9999999 Q
;
EXTINFO S (XTBDESG,XTBPKG,XTBPRIO,XTBVER,XTBSEQ,XTBSUB)=""
F X XMREC Q:XMER<0!(XMRG["Description") DO Q:$D(NOFILE)
.K NOFILE
.Q:XMRG["====="
.I XMRG["Designation" S (XTBDESG,XTBINST)=$P(XMRG,"Designation: ",2) Q:$D(NOFILE) DO
..Q:XTBINST'["*" ;*p114*-REM
..S XTBY=$P(XTBDESG,"*",2) I XTBY'?1.2N1".".N S XTBY=XTBY_".0",$P(XTBINST,"*",2)=XTBY
.I XTBDESG="" S NOFILE=1 Q
.I $D(^XPD(9.9,"B",XTBDESG)) S NOFILE=1 Q ; already done
.I XMRG["Package" DO
..S XTBPKG=$P(XMRG,"Package : ",2),XTBPKG=$P(XTBPKG,"Priority: ",1),XTBPKG=$E(XTBPKG,1,35)
..S XTBX=$L(XTBPKG)
..F XX=XTBX:-1 S XTBY=$E(XTBPKG,XX,XX) Q:($A(XTBY)>64)!(XTBY="") I $A(XTBY)=32 S $E(XTBPKG,XX,XX)="z"
..I XTBPKG["z" S XTBPKG=$P(XTBPKG,"z",1)
.I XMRG["Priority" S XTBPRIO=$P(XMRG,"Priority: ",2) DO
..S XTBPRIO=$P(XTBPRIO," ",1) S X=XTBPRIO X ^%ZOSF("UPPERCASE") S XTBPRIO=X
.I XMRG["Version" S XTBVER=$P(XMRG,"Version: ",1) DO
..S XTBSEQ=$P(XTBVER,"#",2),XTBSEQ=$P(XTBSEQ," ",1)
..S XTBVER=$P(XTBVER,"Version : ",2),XTBVER=+XTBVER
.I XMRG["Compliance Date:" S XTBCMPDT=$P(XMRG,"Compliance Date: ",2)
.I XMRG["Subject" S XTBSUB=$P(XMRG,"Subject: ",2),XTBSUB=$E(XTBSUB,1,50),XTBSUB=$TR(XTBSUB,":;","--")
G:$D(NOFILE) EXIT
;
FILE K DO,DD S (DIC,DIE)="^XPD(9.9,",DIC(0)="M",X=XTBDESG
S XTBRCPDT=$G(^XMB(3.9,XMZ,.6)) I XTBRCPDT="" S XTBRCPDT=DT
S DIC("DR")="1////"_XTBRCPDT_";2///"_XTBPRIO_";3///"_XTBPKG_";4////"_XTBSEQ_";5////"_XTBVER_";6///"_XTBSUB_";7///"_XTBINST_";8///"_XTBCMPDT_";11////"_XTBPTYPE
D FILE^DICN
;
EXIT G EXITA^XTPMKPCF
;
NIGHT S XTBPURGI=$P($G(^XPD(9.95,1,0)),U,3) ;purge y/n
K ^TMP($J) S XTBX="",XTBLN=8,XTBCNT=0
S NIGHT=1 D TEXT S Y=DT X ^DD("DD") S XTBRUNDT=Y
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
.K XTBKILLD
.S XTBDTA=$G(^XPD(9.9,XTBDA,0)) Q:XTBDTA=""
.S XTBINST=$P(XTBDTA,U,8) Q:XTBINST=""
.S XTBPTYPE=$P(XTBDTA,U,10)
.S XTBXX=$O(^XPD(9.7,"B",XTBINST,9999999999),-1) I $G(^XPD(9.7,+XTBXX,2))[" TEST v" S XTBXX=""
.I $P($G(^XPD(9.7,+XTBXX,0)),U,9)=3!(XTBPTYPE=1&($P(XTBDTA,U,11)]"")),XTBPURGI=1 DO Q:$D(XTBKILLD) ; installed, check purge flag
..S DA=XTBDA,DIK="^XPD(9.9," D ^DIK S XTBKILLD=1 K DA,DIK Q
.I XTBXX]"",XTBPTYPE=1 S XTBPTYPE="",$P(^XPD(9.9,XTBDA,0),U,10)="" ;found In INSTALL
.Q:XTBPTYPE=1&($P(XTBDTA,U,11)]"") ;non-kids, has install date
.Q:$P($G(^XPD(9.7,+XTBXX,0)),U,9)=3
.I (DT>$P(XTBDTA,U,9)) D SET
I '$D(^TMP($J,9,0)) K ^TMP($J) S ^TMP($J,3,0)="",^TMP($J,4,0)=" No Delinquent Patches were found."
S ^TMP($J,XTBLN,0)="",XTBLN=XTBLN+1
I XTBCNT>0 S ^TMP($J,XTBLN,0)="Total: "_XTBCNT,XTBLN=XTBLN+1
S ^TMP($J,XTBLN,0)="",XTBLN=XTBLN+1
S XMSUB="Patch Monitor Report for "_^DD("SITE")_" for "_XTBRUNDT
N DUZ S XMDUZ=.5,XMTEXT="^TMP($J,",XMY("G.XTPM PATCH MONITOR")="",XMY(.5)="" D ^XMD
; purge old data
I +XTBPURGI=0 D ^XTPMKPP
G EXIT
;
SET S XTBPTNM=$P(XTBDTA,U,1),XTBSUBJ=$E($P(XTBDTA,U,7),1,20)
S X=$P(XTBDTA,U,3),XTBPRIO=$S(X="m":"Mandatory",X="e":"Emergency",1:"Unknown")
S (X1,Y)=$P(XTBDTA,U,2) X ^DD("DD") S XTBRECPT=Y
S (Y,YY1)=$P(XTBDTA,U,9) X ^DD("DD") S XTBINSTX=Y ; compliance date
I YY1<DT,'$D(NIGHT) S XTBINSTX=Y_" *"
S XTBPKG=$P(XTBPTNM,"*",1),XTBPKGPT=$O(^DIC(9.4,"C",XTBPKG,0))
S XTBPCTVR=+$P(XTBPTNM,"*",2),XTBPLVER=+$G(^DIC(9.4,+XTBPKGPT,"VERSION"))
I XTBPCTVR>XTBPLVER,XTBPLVER>0 S XTBINSTX="Future Version"
I XTBPCTVR>XTBPLVER,XTBPLVER=0 S $P(^XPD(9.9,XTBDA,0),U,10)=1,XTBINSTX="CompleteByHand"
I XTBPCTVR=999 S XTBINSTX="CompleteByHand" ;mainly new Mailman domains
I XTBINSTX="Future Version"&($D(NIGHT)) Q
I XTBINSTX="Future Version"&($D(XTBPSTD)) Q
S XTBLN=XTBLN+1 ; first line=9
S XTBCNT=XTBCNT+1
S XTBDTA=""
S $E(XTBDTA,1)=XTBPTNM,$E(XTBDTA,15)=XTBSUBJ,$E(XTBDTA,38)=XTBPRIO,$E(XTBDTA,51)=XTBRECPT,$E(XTBDTA,64)=XTBINSTX
S ^TMP($J,XTBLN,0)=XTBDTA,XTBLN=XTBLN+1
S ^TMP($J,XTBLN,0)="",XTBLN=XTBLN+1
Q
;
TEXT S ^TMP($J,1,0)=""
S ^TMP($J,2,0)="The following patches are not installed at this site and are past the"
S ^TMP($J,3,0)="designated installation time:"
S ^TMP($J,4,0)=""
S ^TMP($J,5,0)=" Compliance"
S ^TMP($J,6,0)="Patch # Subject Priority Recpt Date Date"
S ^TMP($J,7,0)="------- ------- -------- ----- ---- ----------"
S ^TMP($J,8,0)=""
Q
;
REG ; regular notification
K ^TMP($J) S XTBX="",XTBLN=8,XTBCNT=0
D TEXT S Y=DT X ^DD("DD") S XTBRUNDT=Y
S ^TMP($J,2,0)="The following patches are uninstalled at this site:" K ^TMP($J,3,0)
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)),XTBINST=$P(XTBDTA,U,8)
.Q:XTBDTA=""!(XTBINST="") ;no data or no install name
.S XTBXX=$O(^XPD(9.7,"B",XTBINST,9999999999),-1) I $G(^XPD(9.7,+XTBXX,2))[" TEST v" S XTBXX=""
.Q:$P(XTBDTA,U,10)=1&($P(XTBDTA,U,11)]"") ;non-kids
.Q:$P($G(^XPD(9.7,+XTBXX,0)),U,9)=3
.D SET
I '$D(^TMP($J,9,0)) G EXIT
S ^TMP($J,XTBLN,0)="",XTBLN=XTBLN+1
S ^TMP($J,XTBLN,0)="Total: "_XTBCNT,XTBLN=XTBLN+1
S ^TMP($J,XTBLN,0)="",XTBLN=XTBLN+1
S XMSUB="Uninstalled Patch Report for "_^DD("SITE")_" for "_XTBRUNDT
N DUZ K XMY
S XMDUZ=.5,XMTEXT="^TMP($J," D MG,^XMD
G EXIT
;
RPT W @IOF,!,"Complete Uninstalled Patch Report for "_^DD("SITE"),!!!
S %ZIS="AEQ" D ^%ZIS G:POP EXIT
I $D(IO("Q")) S ZTIO=ION,ZTSAVE="",ZTRTN="RPT1^XTPMKPTC",ZTDESC="Uninstalled Patch Report" D ^%ZTLOAD D HOME^%ZIS
I $D(ZTSK) W !,"Queued as task# ",ZTSK,!! H 2 G EXIT
;
RPT1 U IO K ^TMP($J) S XTBX="",XTBLN=8,XTBCNT=0
D TEXT S Y=DT X ^DD("DD") S XTBRUNDT=Y
K ^TMP($J,2,0),^TMP($J,3,0)
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)),XTBINST=$P(XTBDTA,U,8) Q:XTBDTA=""!(XTBINST="") ; no data or no install name
.S XTBXX=$O(^XPD(9.7,"B",XTBINST,9999999999),-1) I $G(^XPD(9.7,+XTBXX,2))[" TEST v" S XTBXX=""
.Q:$P(XTBDTA,U,10)=1&($P(XTBDTA,U,11)]"") ;non-kids
.Q:$P($G(^XPD(9.7,+XTBXX,0)),U,9)=3
.D SET
I '$D(^TMP($J,9,0)) S ^TMP($J,XTBLN,0)="",XTBLN=XTBLN+1,^TMP($J,XTBLN,0)=" Nothing to report",XTBLN=XTBLN+1
S ^TMP($J,XTBLN,0)="",XTBLN=XTBLN+1
I XTBCNT>0 S ^TMP($J,XTBLN,0)="Total: "_XTBCNT,XTBLN=XTBLN+1
S ^TMP($J,XTBLN,0)="",XTBLN=XTBLN+1
S PG=1,XTBHDR="Uninstalled Patch Report for "_^DD("SITE")_" for "_XTBRUNDT
W:IOST?1"C-".E @IOF W !,XTBHDR,?(IOM-12),"Page: ",PG,!
F XTBLN=0:0 S XTBLN=$O(^TMP($J,XTBLN)) Q:XTBLN="" W ^TMP($J,XTBLN,0),! I $Y>(IOSL-5) S PG=PG+1 D PAUSE W @IOF,!,XTBHDR,?(IOM-12),"Page: ",PG,!!
G EXIT
;
PASTDUE W @IOF,!,"Past Due Patch Report for "_^DD("SITE"),!!!
S %ZIS="AEQ" D ^%ZIS G:POP EXIT
I $D(IO("Q")) S ZTIO=ION,ZTSAVE="",ZTRTN="PASTD1^XTPMKPTC",ZTDESC="Past Due Patch Report" D ^%ZTLOAD D HOME^%ZIS
I $D(ZTSK) W !,"Queued as task# ",ZTSK,!! H 2 G EXIT
;
PASTD1 U IO K ^TMP($J) S XTBX="",XTBLN=8,XTBCNT=0
S XTBPSTD=1
D TEXT S Y=DT X ^DD("DD") S XTBRUNDT=Y
K ^TMP($J,2,0),^TMP($J,3,0)
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)),XTBINST=$P(XTBDTA,U,8) Q:XTBDTA=""!(XTBINST="")
.S XTBXX=$O(^XPD(9.7,"B",XTBINST,9999999999),-1) I $G(^XPD(9.7,+XTBXX,2))[" TEST v" S XTBXX=""
.Q:$P(XTBDTA,U,10)=1&($P(XTBDTA,U,11)]"") ;non-kids
.Q:$P($G(^XPD(9.7,+XTBXX,0)),U,9)=3
.S XTBCOMPD=$P(XTBDTA,U,9) Q:XTBCOMPD'<DT
.D SET
I '$D(^TMP($J,9,0)) S ^TMP($J,XTBLN,0)="",XTBLN=XTBLN+1,^TMP($J,XTBLN,0)=" Nothing to report",XTBLN=XTBLN+1
S ^TMP($J,XTBLN,0)="",XTBLN=XTBLN+1
I XTBCNT>0 S ^TMP($J,XTBLN,0)="Total: "_XTBCNT,XTBLN=XTBLN+1
S ^TMP($J,XTBLN,0)="",XTBLN=XTBLN+1
S ^TMP($J,XTBLN,0)="",XTBLN=XTBLN+1
S PG=1,XTBHDR="Past Due Patch Report for "_^DD("SITE")_" for "_XTBRUNDT
W:IOST?1"C-".E @IOF W !,XTBHDR,?(IOM-12),"Page: ",PG,!
F XTBLN=0:0 S XTBLN=$O(^TMP($J,XTBLN)) Q:XTBLN="" W ^TMP($J,XTBLN,0),! I $Y>(IOSL-5) S PG=PG+1 D PAUSE W @IOF,!,XTBHDR,?(IOM-12),"Page: ",PG,!!
K XTBPSTD G EXIT
;
PAUSE W !,"Press RETURN to continue or '^' to exit: " R XTBANS:DTIME
I XTBANS["^" S XTBLN=9999
Q
;
MG F XTBMG=0:0 S XTBMG=$O(^XPD(9.95,1,1,"B",XTBMG)) Q:XTBMG="" DO
.S XTBMGN=$P(^XMB(3.8,XTBMG,0),U)
.S XMY("G."_XTBMGN)=""
S XMY("G.XTPM PATCH MONITOR USER")="",XMY(.5)=""
Q
XTPMKPTC ;OAK/BP - PATCH MONITOR FUNCTIONS ;09/10/2008
+1 ;;7.3;TOOLKIT;**98,100,114**; Apr 25, 1995;Build 5
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
SRVR NEW XMB
XECUTE XMREC
+1 SET XTBMLN1=$GET(^XMB(3.9,XMZ,0))
+2 IF XTBMLN1["COMPLIANCE DATE CHANGE"
GOTO CKCMPDT
+3 ;
CHECK IF XTBMLN1["TEST"
GOTO EXIT
+1 IF XTBMLN1["COMPLIANCE DATE CHANGE"
GOTO CKCMPDT
+2 IF XTBMLN1["Entered in error patch"
Begin DoDot:1
+3 FOR XTBX=1:1:8
SET XTBY=$GET(^XMB(3.9,XMZ,2,+XTBX,0))
IF XTBY["The patch is"
Begin DoDot:2
+4 KILL OUT
SET X=$PIECE(XTBY,"'",2)
SET DIC(0)="QLM"
SET DIC="^XPD(9.9,"
DO ^DIC
IF Y<0
SET OUT=1
QUIT
+5 SET DIK=DIC
SET DA=+Y
DO ^DIK
KILL DIC,DIK,DA,XTBX,XTBY,Y,X
SET OUT=1
QUIT
End DoDot:2
IF $DATA(OUT)
QUIT
End DoDot:1
IF $DATA(OUT)
KILL OUT
GOTO EXIT
+6 IF XTBMLN1'["SEQ #"!(XTBMLN1'["National Patch Module")
GOTO EXIT
+7 ;
CKCMPDT ;compliance date chg check
DO CMPDTCG^XTPMKPCF
IF $DATA(XTBCMDCG)
KILL XTBCMDCG
GOTO EXIT
+1 ;assume NON-KIDS until verified
SET XTBPTYPE=1
+2 FOR XTBX=0:0
SET XTBX=$ORDER(^XMB(3.9,XMZ,2,XTBX))
IF XTBX=""!(+XTBX=0)
QUIT
SET XTBY=$GET(^XMB(3.9,XMZ,2,XTBX,0))
IF XTBY["$KID"
Begin DoDot:1
+3 SET XTBZ=$ORDER(^XMB(3.9,XMZ,2,XTBX))
IF $GET(^XMB(3.9,XMZ,2,XTBZ,0))["**INSTALL NAME**"
SET XTBPTYPE=""
SET XTBX=9999999
QUIT
End DoDot:1
+4 ;
EXTINFO SET (XTBDESG,XTBPKG,XTBPRIO,XTBVER,XTBSEQ,XTBSUB)=""
+1 FOR
XECUTE XMREC
IF XMER<0!(XMRG["Description")
QUIT
Begin DoDot:1
+2 KILL NOFILE
+3 IF XMRG["====="
QUIT
+4 IF XMRG["Designation"
SET (XTBDESG,XTBINST)=$PIECE(XMRG,"Designation: ",2)
IF $DATA(NOFILE)
QUIT
Begin DoDot:2
+5 ;*p114*-REM
IF XTBINST'["*"
QUIT
+6 SET XTBY=$PIECE(XTBDESG,"*",2)
IF XTBY'?1.2N1".".N
SET XTBY=XTBY_".0"
SET $PIECE(XTBINST,"*",2)=XTBY
End DoDot:2
+7 IF XTBDESG=""
SET NOFILE=1
QUIT
+8 ; already done
IF $DATA(^XPD(9.9,"B",XTBDESG))
SET NOFILE=1
QUIT
+9 IF XMRG["Package"
Begin DoDot:2
+10 SET XTBPKG=$PIECE(XMRG,"Package : ",2)
SET XTBPKG=$PIECE(XTBPKG,"Priority: ",1)
SET XTBPKG=$EXTRACT(XTBPKG,1,35)
+11 SET XTBX=$LENGTH(XTBPKG)
+12 FOR XX=XTBX:-1
SET XTBY=$EXTRACT(XTBPKG,XX,XX)
IF ($ASCII(XTBY)>64)!(XTBY="")
QUIT
IF $ASCII(XTBY)=32
SET $EXTRACT(XTBPKG,XX,XX)="z"
+13 IF XTBPKG["z"
SET XTBPKG=$PIECE(XTBPKG,"z",1)
End DoDot:2
+14 IF XMRG["Priority"
SET XTBPRIO=$PIECE(XMRG,"Priority: ",2)
Begin DoDot:2
+15 SET XTBPRIO=$PIECE(XTBPRIO," ",1)
SET X=XTBPRIO
XECUTE ^%ZOSF("UPPERCASE")
SET XTBPRIO=X
End DoDot:2
+16 IF XMRG["Version"
SET XTBVER=$PIECE(XMRG,"Version: ",1)
Begin DoDot:2
+17 SET XTBSEQ=$PIECE(XTBVER,"#",2)
SET XTBSEQ=$PIECE(XTBSEQ," ",1)
+18 SET XTBVER=$PIECE(XTBVER,"Version : ",2)
SET XTBVER=+XTBVER
End DoDot:2
+19 IF XMRG["Compliance Date:"
SET XTBCMPDT=$PIECE(XMRG,"Compliance Date: ",2)
+20 IF XMRG["Subject"
SET XTBSUB=$PIECE(XMRG,"Subject: ",2)
SET XTBSUB=$EXTRACT(XTBSUB,1,50)
SET XTBSUB=$TRANSLATE(XTBSUB,":;","--")
End DoDot:1
IF $DATA(NOFILE)
QUIT
+21 IF $DATA(NOFILE)
GOTO EXIT
+22 ;
FILE KILL DO,DD
SET (DIC,DIE)="^XPD(9.9,"
SET DIC(0)="M"
SET X=XTBDESG
+1 SET XTBRCPDT=$GET(^XMB(3.9,XMZ,.6))
IF XTBRCPDT=""
SET XTBRCPDT=DT
+2 SET DIC("DR")="1////"_XTBRCPDT_";2///"_XTBPRIO_";3///"_XTBPKG_";4////"_XTBSEQ_";5////"_XTBVER_";6///"_XTBSUB_";7///"_XTBINST_";8///"_XTBCMPDT_";11////"_XTBPTYPE
+3 DO FILE^DICN
+4 ;
EXIT GOTO EXITA^XTPMKPCF
+1 ;
NIGHT ;purge y/n
SET XTBPURGI=$PIECE($GET(^XPD(9.95,1,0)),U,3)
+1 KILL ^TMP($JOB)
SET XTBX=""
SET XTBLN=8
SET XTBCNT=0
+2 SET NIGHT=1
DO TEXT
SET Y=DT
XECUTE ^DD("DD")
SET XTBRUNDT=Y
+3 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
+4 KILL XTBKILLD
+5 SET XTBDTA=$GET(^XPD(9.9,XTBDA,0))
IF XTBDTA=""
QUIT
+6 SET XTBINST=$PIECE(XTBDTA,U,8)
IF XTBINST=""
QUIT
+7 SET XTBPTYPE=$PIECE(XTBDTA,U,10)
+8 SET XTBXX=$ORDER(^XPD(9.7,"B",XTBINST,9999999999),-1)
IF $GET(^XPD(9.7,+XTBXX,2))[" TEST v"
SET XTBXX=""
+9 ; installed, check purge flag
IF $PIECE($GET(^XPD(9.7,+XTBXX,0)),U,9)=3!(XTBPTYPE=1&($PIECE(XTBDTA,U,11)]""))
IF XTBPURGI=1
Begin DoDot:2
+10 SET DA=XTBDA
SET DIK="^XPD(9.9,"
DO ^DIK
SET XTBKILLD=1
KILL DA,DIK
QUIT
End DoDot:2
IF $DATA(XTBKILLD)
QUIT
+11 ;found In INSTALL
IF XTBXX]""
IF XTBPTYPE=1
SET XTBPTYPE=""
SET $PIECE(^XPD(9.9,XTBDA,0),U,10)=""
+12 ;non-kids, has install date
IF XTBPTYPE=1&($PIECE(XTBDTA,U,11)]"")
QUIT
+13 IF $PIECE($GET(^XPD(9.7,+XTBXX,0)),U,9)=3
QUIT
+14 IF (DT>$PIECE(XTBDTA,U,9))
DO SET
End DoDot:1
+15 IF '$DATA(^TMP($JOB,9,0))
KILL ^TMP($JOB)
SET ^TMP($JOB,3,0)=""
SET ^TMP($JOB,4,0)=" No Delinquent Patches were found."
+16 SET ^TMP($JOB,XTBLN,0)=""
SET XTBLN=XTBLN+1
+17 IF XTBCNT>0
SET ^TMP($JOB,XTBLN,0)="Total: "_XTBCNT
SET XTBLN=XTBLN+1
+18 SET ^TMP($JOB,XTBLN,0)=""
SET XTBLN=XTBLN+1
+19 SET XMSUB="Patch Monitor Report for "_^DD("SITE")_" for "_XTBRUNDT
+20 NEW DUZ
SET XMDUZ=.5
SET XMTEXT="^TMP($J,"
SET XMY("G.XTPM PATCH MONITOR")=""
SET XMY(.5)=""
DO ^XMD
+21 ; purge old data
+22 IF +XTBPURGI=0
DO ^XTPMKPP
+23 GOTO EXIT
+24 ;
SET SET XTBPTNM=$PIECE(XTBDTA,U,1)
SET XTBSUBJ=$EXTRACT($PIECE(XTBDTA,U,7),1,20)
+1 SET X=$PIECE(XTBDTA,U,3)
SET XTBPRIO=$SELECT(X="m":"Mandatory",X="e":"Emergency",1:"Unknown")
+2 SET (X1,Y)=$PIECE(XTBDTA,U,2)
XECUTE ^DD("DD")
SET XTBRECPT=Y
+3 ; compliance date
SET (Y,YY1)=$PIECE(XTBDTA,U,9)
XECUTE ^DD("DD")
SET XTBINSTX=Y
+4 IF YY1<DT
IF '$DATA(NIGHT)
SET XTBINSTX=Y_" *"
+5 SET XTBPKG=$PIECE(XTBPTNM,"*",1)
SET XTBPKGPT=$ORDER(^DIC(9.4,"C",XTBPKG,0))
+6 SET XTBPCTVR=+$PIECE(XTBPTNM,"*",2)
SET XTBPLVER=+$GET(^DIC(9.4,+XTBPKGPT,"VERSION"))
+7 IF XTBPCTVR>XTBPLVER
IF XTBPLVER>0
SET XTBINSTX="Future Version"
+8 IF XTBPCTVR>XTBPLVER
IF XTBPLVER=0
SET $PIECE(^XPD(9.9,XTBDA,0),U,10)=1
SET XTBINSTX="CompleteByHand"
+9 ;mainly new Mailman domains
IF XTBPCTVR=999
SET XTBINSTX="CompleteByHand"
+10 IF XTBINSTX="Future Version"&($DATA(NIGHT))
QUIT
+11 IF XTBINSTX="Future Version"&($DATA(XTBPSTD))
QUIT
+12 ; first line=9
SET XTBLN=XTBLN+1
+13 SET XTBCNT=XTBCNT+1
+14 SET XTBDTA=""
+15 SET $EXTRACT(XTBDTA,1)=XTBPTNM
SET $EXTRACT(XTBDTA,15)=XTBSUBJ
SET $EXTRACT(XTBDTA,38)=XTBPRIO
SET $EXTRACT(XTBDTA,51)=XTBRECPT
SET $EXTRACT(XTBDTA,64)=XTBINSTX
+16 SET ^TMP($JOB,XTBLN,0)=XTBDTA
SET XTBLN=XTBLN+1
+17 SET ^TMP($JOB,XTBLN,0)=""
SET XTBLN=XTBLN+1
+18 QUIT
+19 ;
TEXT SET ^TMP($JOB,1,0)=""
+1 SET ^TMP($JOB,2,0)="The following patches are not installed at this site and are past the"
+2 SET ^TMP($JOB,3,0)="designated installation time:"
+3 SET ^TMP($JOB,4,0)=""
+4 SET ^TMP($JOB,5,0)=" Compliance"
+5 SET ^TMP($JOB,6,0)="Patch # Subject Priority Recpt Date Date"
+6 SET ^TMP($JOB,7,0)="------- ------- -------- ----- ---- ----------"
+7 SET ^TMP($JOB,8,0)=""
+8 QUIT
+9 ;
REG ; regular notification
+1 KILL ^TMP($JOB)
SET XTBX=""
SET XTBLN=8
SET XTBCNT=0
+2 DO TEXT
SET Y=DT
XECUTE ^DD("DD")
SET XTBRUNDT=Y
+3 SET ^TMP($JOB,2,0)="The following patches are uninstalled at this site:"
KILL ^TMP($JOB,3,0)
+4 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
+5 SET XTBDTA=$GET(^XPD(9.9,XTBDA,0))
SET XTBINST=$PIECE(XTBDTA,U,8)
+6 ;no data or no install name
IF XTBDTA=""!(XTBINST="")
QUIT
+7 SET XTBXX=$ORDER(^XPD(9.7,"B",XTBINST,9999999999),-1)
IF $GET(^XPD(9.7,+XTBXX,2))[" TEST v"
SET XTBXX=""
+8 ;non-kids
IF $PIECE(XTBDTA,U,10)=1&($PIECE(XTBDTA,U,11)]"")
QUIT
+9 IF $PIECE($GET(^XPD(9.7,+XTBXX,0)),U,9)=3
QUIT
+10 DO SET
End DoDot:1
+11 IF '$DATA(^TMP($JOB,9,0))
GOTO EXIT
+12 SET ^TMP($JOB,XTBLN,0)=""
SET XTBLN=XTBLN+1
+13 SET ^TMP($JOB,XTBLN,0)="Total: "_XTBCNT
SET XTBLN=XTBLN+1
+14 SET ^TMP($JOB,XTBLN,0)=""
SET XTBLN=XTBLN+1
+15 SET XMSUB="Uninstalled Patch Report for "_^DD("SITE")_" for "_XTBRUNDT
+16 NEW DUZ
KILL XMY
+17 SET XMDUZ=.5
SET XMTEXT="^TMP($J,"
DO MG
DO ^XMD
+18 GOTO EXIT
+19 ;
RPT WRITE @IOF,!,"Complete Uninstalled Patch Report for "_^DD("SITE"),!!!
+1 SET %ZIS="AEQ"
DO ^%ZIS
IF POP
GOTO EXIT
+2 IF $DATA(IO("Q"))
SET ZTIO=ION
SET ZTSAVE=""
SET ZTRTN="RPT1^XTPMKPTC"
SET ZTDESC="Uninstalled Patch Report"
DO ^%ZTLOAD
DO HOME^%ZIS
+3 IF $DATA(ZTSK)
WRITE !,"Queued as task# ",ZTSK,!!
HANG 2
GOTO EXIT
+4 ;
RPT1 USE IO
KILL ^TMP($JOB)
SET XTBX=""
SET XTBLN=8
SET XTBCNT=0
+1 DO TEXT
SET Y=DT
XECUTE ^DD("DD")
SET XTBRUNDT=Y
+2 KILL ^TMP($JOB,2,0),^TMP($JOB,3,0)
+3 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
+4 ; no data or no install name
SET XTBDTA=$GET(^XPD(9.9,XTBDA,0))
SET XTBINST=$PIECE(XTBDTA,U,8)
IF XTBDTA=""!(XTBINST="")
QUIT
+5 SET XTBXX=$ORDER(^XPD(9.7,"B",XTBINST,9999999999),-1)
IF $GET(^XPD(9.7,+XTBXX,2))[" TEST v"
SET XTBXX=""
+6 ;non-kids
IF $PIECE(XTBDTA,U,10)=1&($PIECE(XTBDTA,U,11)]"")
QUIT
+7 IF $PIECE($GET(^XPD(9.7,+XTBXX,0)),U,9)=3
QUIT
+8 DO SET
End DoDot:1
+9 IF '$DATA(^TMP($JOB,9,0))
SET ^TMP($JOB,XTBLN,0)=""
SET XTBLN=XTBLN+1
SET ^TMP($JOB,XTBLN,0)=" Nothing to report"
SET XTBLN=XTBLN+1
+10 SET ^TMP($JOB,XTBLN,0)=""
SET XTBLN=XTBLN+1
+11 IF XTBCNT>0
SET ^TMP($JOB,XTBLN,0)="Total: "_XTBCNT
SET XTBLN=XTBLN+1
+12 SET ^TMP($JOB,XTBLN,0)=""
SET XTBLN=XTBLN+1
+13 SET PG=1
SET XTBHDR="Uninstalled Patch Report for "_^DD("SITE")_" for "_XTBRUNDT
+14 IF IOST?1"C-".E
WRITE @IOF
WRITE !,XTBHDR,?(IOM-12),"Page: ",PG,!
+15 FOR XTBLN=0:0
SET XTBLN=$ORDER(^TMP($JOB,XTBLN))
IF XTBLN=""
QUIT
WRITE ^TMP($JOB,XTBLN,0),!
IF $Y>(IOSL-5)
SET PG=PG+1
DO PAUSE
WRITE @IOF,!,XTBHDR,?(IOM-12),"Page: ",PG,!!
+16 GOTO EXIT
+17 ;
PASTDUE WRITE @IOF,!,"Past Due Patch Report for "_^DD("SITE"),!!!
+1 SET %ZIS="AEQ"
DO ^%ZIS
IF POP
GOTO EXIT
+2 IF $DATA(IO("Q"))
SET ZTIO=ION
SET ZTSAVE=""
SET ZTRTN="PASTD1^XTPMKPTC"
SET ZTDESC="Past Due Patch Report"
DO ^%ZTLOAD
DO HOME^%ZIS
+3 IF $DATA(ZTSK)
WRITE !,"Queued as task# ",ZTSK,!!
HANG 2
GOTO EXIT
+4 ;
PASTD1 USE IO
KILL ^TMP($JOB)
SET XTBX=""
SET XTBLN=8
SET XTBCNT=0
+1 SET XTBPSTD=1
+2 DO TEXT
SET Y=DT
XECUTE ^DD("DD")
SET XTBRUNDT=Y
+3 KILL ^TMP($JOB,2,0),^TMP($JOB,3,0)
+4 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
+5 SET XTBDTA=$GET(^XPD(9.9,XTBDA,0))
SET XTBINST=$PIECE(XTBDTA,U,8)
IF XTBDTA=""!(XTBINST="")
QUIT
+6 SET XTBXX=$ORDER(^XPD(9.7,"B",XTBINST,9999999999),-1)
IF $GET(^XPD(9.7,+XTBXX,2))[" TEST v"
SET XTBXX=""
+7 ;non-kids
IF $PIECE(XTBDTA,U,10)=1&($PIECE(XTBDTA,U,11)]"")
QUIT
+8 IF $PIECE($GET(^XPD(9.7,+XTBXX,0)),U,9)=3
QUIT
+9 SET XTBCOMPD=$PIECE(XTBDTA,U,9)
IF XTBCOMPD'<DT
QUIT
+10 DO SET
End DoDot:1
+11 IF '$DATA(^TMP($JOB,9,0))
SET ^TMP($JOB,XTBLN,0)=""
SET XTBLN=XTBLN+1
SET ^TMP($JOB,XTBLN,0)=" Nothing to report"
SET XTBLN=XTBLN+1
+12 SET ^TMP($JOB,XTBLN,0)=""
SET XTBLN=XTBLN+1
+13 IF XTBCNT>0
SET ^TMP($JOB,XTBLN,0)="Total: "_XTBCNT
SET XTBLN=XTBLN+1
+14 SET ^TMP($JOB,XTBLN,0)=""
SET XTBLN=XTBLN+1
+15 SET ^TMP($JOB,XTBLN,0)=""
SET XTBLN=XTBLN+1
+16 SET PG=1
SET XTBHDR="Past Due Patch Report for "_^DD("SITE")_" for "_XTBRUNDT
+17 IF IOST?1"C-".E
WRITE @IOF
WRITE !,XTBHDR,?(IOM-12),"Page: ",PG,!
+18 FOR XTBLN=0:0
SET XTBLN=$ORDER(^TMP($JOB,XTBLN))
IF XTBLN=""
QUIT
WRITE ^TMP($JOB,XTBLN,0),!
IF $Y>(IOSL-5)
SET PG=PG+1
DO PAUSE
WRITE @IOF,!,XTBHDR,?(IOM-12),"Page: ",PG,!!
+19 KILL XTBPSTD
GOTO EXIT
+20 ;
PAUSE WRITE !,"Press RETURN to continue or '^' to exit: "
READ XTBANS:DTIME
+1 IF XTBANS["^"
SET XTBLN=9999
+2 QUIT
+3 ;
MG FOR XTBMG=0:0
SET XTBMG=$ORDER(^XPD(9.95,1,1,"B",XTBMG))
IF XTBMG=""
QUIT
Begin DoDot:1
+1 SET XTBMGN=$PIECE(^XMB(3.8,XTBMG,0),U)
+2 SET XMY("G."_XTBMGN)=""
End DoDot:1
+3 SET XMY("G.XTPM PATCH MONITOR USER")=""
SET XMY(.5)=""
+4 QUIT
