- XTPMKPTC ;OAK/BP - PATCH MONITOR FUNCTIONS ;09/10/2008
- ;;7.3;TOOLKIT;**98,100,114**; Apr 25, 1995;Build 1
- ;;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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTPMKPTC 9530 printed Feb 19, 2025@00:08:03 Page 2
- XTPMKPTC ;OAK/BP - PATCH MONITOR FUNCTIONS ;09/10/2008
- +1 ;;7.3;TOOLKIT;**98,100,114**; Apr 25, 1995;Build 1
- +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