XTPMSTA3 ;OAK/BP - PRINT PATCH STATISTICS BY RELEASED DATE; ; 3/15/11 7:29am
;;7.3;TOOLKIT;**130**; Apr 25, 1995;Build 2
;Per VHA Directive 2004-038, this routine should not be modified.
S IOP="HOME" D ^%ZIS K IOP
EN W @IOF,"Patch Monitor Statistics By Released Date",!!!
;
DATE W ! S %DT="AEP"
S %DT("A")="Enter BEGINNING Released date: " D ^%DT G:Y<0 EXIT S XTBBDT=Y X ^DD("DD") S XTBBDT1=Y
S %DT="AE",%DT("A")=" and ENDING Released date: " D ^%DT G:Y<0 EXIT S XTBEDT=Y X ^DD("DD") S XTBEDT1=Y
I XTBEDT<XTBBDT W !!,$C(7),"Starting date is later than ending date.",!! H 2 G DATE
W !!,"Do you want to see the patch data" S %=2 D YN^DICN S XTBVIEW=%
;
DEV W !! S %ZIS="AEQ" D ^%ZIS G:POP EXIT
I $D(IO("Q")) S ZTIO=ION,ZTRTN="SORT^XTPMSTA3",ZTSAVE("XTB*")="",ZTDESC="Patch Monitor Statistics By Released Date" D ^%ZTLOAD D HOME^%ZIS
I $D(ZTSK) W !,"Queued as task #",ZTSK H 2 G EXIT
;
; sort patches by released date
SORT U IO K ^TMP($J)
S XTBDA=0
F S XTBDA=$O(^XPD(9.9,XTBDA)) Q:'XTBDA DO
.S XTBDTA=$G(^XPD(9.9,XTBDA,0)) Q:XTBDTA=""
.S XTBPTNAM=$P(XTBDTA,U,1),XTBNMSP=$P($P(XTBDTA,U,4)," - ",1) Q:XTBNMSP="" ;parent package missing in file
.S XTBRELDT=$P(XTBDTA,U,2),XTBPRIOR=$P(XTBDTA,U,3),XTBCPLDT=$P(XTBDTA,U,9)
.Q:(XTBRELDT<XTBBDT)!(XTBRELDT>XTBEDT)
.S ^TMP($J,XTBRELDT,XTBPTNAM,XTBDA)=XTBCPLDT_U_XTBPRIOR
PRINT ;
S Y=DT X ^DD("DD") S XTBCURDT=Y
K XTBLINE S $P(XTBLINE,"-",(IOM-2))="-"
S PG=0 D HDR ; first header
S (XTBTPTCH,XTBTLATE)=0,XTBPTNAM=""
F XTBRELDT=0:0 S XTBRELDT=$O(^TMP($J,XTBRELDT)) Q:XTBRELDT="" F S XTBPTNAM=$O(^TMP($J,XTBRELDT,XTBPTNAM)) Q:XTBPTNAM="" D Q:$D(XTBOUT)
.F XTBDA=0:0 S XTBDA=$O(^TMP($J,XTBRELDT,XTBPTNAM,XTBDA)) Q:XTBDA="" D Q:$D(XTBOUT)
..S XTBTPTCH=XTBTPTCH+1
..S XTBDTA=^TMP($J,XTBRELDT,XTBPTNAM,XTBDA)
..S XTBCPLDT=$P(XTBDTA,U),XTBPRIOR=$P(XTBDTA,U,2)
..S XTBRCVDT=$P($G(^XPD(9.9,XTBDA,0)),U,2)
..S XTBPTYPE=$P($G(^XPD(9.9,XTBDA,0)),U,10)
..I +XTBPTYPE=0 S D0=XTBDA D ^XTPMKPCF S XTBINSDT=XTINST K D0
..I +XTBPTYPE=1 S XTBINSDT=$P($G(^XPD(9.9,XTBDA,0)),U,11)
..I XTBINSDT]"" S X1=XTBINSDT,X2=XTBCPLDT D ^%DTC S XTBDAYLT=X
..I XTBINSDT="" S X1=DT,X2=XTBCPLDT D ^%DTC S XTBDAYLT=X
..S Y=XTBINSDT X ^DD("DD") I Y'="" S XTBINSDT=$P(Y,",",1)_","_$E($P(Y,",",2),1,4) ;set date format "MON DD,YYYY"
..S Y=XTBRELDT X ^DD("DD") S XTBRELDX=Y
..S Y=XTBCPLDT X ^DD("DD") S XTBCPLDT=Y
..S XTBPRIOR=$S(XTBPRIOR="m":"Mandatory",XTBPRIOR="e":"Emergency",1:"Unknown")
..I XTBVIEW=1 W XTBRELDX,?14,XTBPTNAM,?27,XTBCPLDT,?41,XTBINSDT,?55,XTBPRIOR
..I XTBVIEW=1,XTBDAYLT>0 W ?67,$J(XTBDAYLT,3,0)_$S(XTBDAYLT>1:" days",1:" day")
..I XTBDAYLT>0 S XTBTLATE=XTBTLATE+1
..I XTBVIEW=1 W ! I $Y>(IOSL-6),IOST?1"C-".E D PAUSE Q:$D(XTBOUT)
..I XTBVIEW=1 I $Y>(IOSL-6) D HDR
G:$D(XTBOUT) EXIT
I $Y>(IOSL-6),IOST?1"C-".E D HDR
W !!?6,"Totals patches received for date range: ",XTBTPTCH,!
W "Total patches installed past compliance date: ",XTBTLATE,!!
S XTBDIVOK=0 I XTBTPTCH>0 S XTBDIVOK=1
W ?25,"Delinquent patch % : ",$S(XTBDIVOK=1:$J((XTBTLATE/XTBTPTCH*100),6,2),1:100)_" %",!
W ?25," Compliance % : ",$S(XTBDIVOK=1:$J(100-(XTBTLATE/XTBTPTCH*100),6,2),1:100)," %",!
I IOST?1"C-".E K XTBANS W !!,"Press ENTER to end " R XTBANS:DTIME
;
EXIT I IOST?1"C-".E W @IOF,!
D ^%ZISC
K %,%DT,%ZIS,XTBNMSP,XTBANS,XTBBDT,XTBBDT1,XTBCPLDT,XTBCPLDX,XTBDA,XTBEDT,XTBEDT1,XTBDAYLT
K XTBINSDT,XTBLINE,XTBNMSP,XTBOLDNM,XTBNMSP,XTBPTNAM,XTBPTYPE,XTBDTA,XTBGPDA
K XTBRCVDT,XTBTLATE,XTBTPTCH,D0,DIC,PG,POP,X,X1,X2,Y,ZTDESC,ZTIO,ZTRTN,ZTSAVE,%T,%Y
K ^TMP($J),XTBOUT,XTBPGF,XTBOLGRP,ZTSK,XTBRELDT,XTBPRIOR,XTBCURDT,XTBDIVOK,XTBVIEW,XTINST
Q
;
HDR S PG=PG+1 I IOST?1"P-".E,PG>1 W @IOF
I IOST?1"C-".E W @IOF
W XTBCURDT S X="Patch Statistical Report for "_^DD("SITE")
W ?(IOM-$L(X)\2),X,?(IOM-12),"Page: ",PG,!,?31,"By Released Date",!
S X="Date range: "_XTBBDT1_" to "_XTBEDT1 W ?(IOM-$L(X)\2),X,!
W !,"Release",?14,"Patch",?27,"Compliance",?41,"Install",?67,"# Days",!
W "Date",?14,"Number",?27,"Date",?41,"Date",?55,"Priority",?67,"Delinquent",!,XTBLINE,!
Q
;
PAUSE Q:IOST'?1"C-".E
K XTBANS,XTBOUT W !!,"Press ENTER to continue or '^' to end " R XTBANS:DTIME
I XTBANS[U!('$T) S (XTBNMSP,XTBPTNAM,XTBCPLDT,XTBDA)="99999999",XTBOUT=1
Q
;
ADDOP ; Add a new option under the XUSER menu option.
N XUA,XUB,XUC
S XUA="XTPM PATCH REPORTS"
S XUB="XTPM PATCH STATS BY RELEASED"
IF $$FIND1^DIC(19,,"X",XUA,,,),$$FIND1^DIC(19,,"X",XUB,,,) S XUC=$$ADD^XPDMENU(XUA,XUB,8,)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTPMSTA3 4529 printed Sep 23, 2025@20:17:58 Page 2
XTPMSTA3 ;OAK/BP - PRINT PATCH STATISTICS BY RELEASED DATE; ; 3/15/11 7:29am
+1 ;;7.3;TOOLKIT;**130**; Apr 25, 1995;Build 2
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 SET IOP="HOME"
DO ^%ZIS
KILL IOP
EN WRITE @IOF,"Patch Monitor Statistics By Released Date",!!!
+1 ;
DATE WRITE !
SET %DT="AEP"
+1 SET %DT("A")="Enter BEGINNING Released date: "
DO ^%DT
if Y<0
GOTO EXIT
SET XTBBDT=Y
XECUTE ^DD("DD")
SET XTBBDT1=Y
+2 SET %DT="AE"
SET %DT("A")=" and ENDING Released date: "
DO ^%DT
if Y<0
GOTO EXIT
SET XTBEDT=Y
XECUTE ^DD("DD")
SET XTBEDT1=Y
+3 IF XTBEDT<XTBBDT
WRITE !!,$CHAR(7),"Starting date is later than ending date.",!!
HANG 2
GOTO DATE
+4 WRITE !!,"Do you want to see the patch data"
SET %=2
DO YN^DICN
SET XTBVIEW=%
+5 ;
DEV WRITE !!
SET %ZIS="AEQ"
DO ^%ZIS
if POP
GOTO EXIT
+1 IF $DATA(IO("Q"))
SET ZTIO=ION
SET ZTRTN="SORT^XTPMSTA3"
SET ZTSAVE("XTB*")=""
SET ZTDESC="Patch Monitor Statistics By Released Date"
DO ^%ZTLOAD
DO HOME^%ZIS
+2 IF $DATA(ZTSK)
WRITE !,"Queued as task #",ZTSK
HANG 2
GOTO EXIT
+3 ;
+4 ; sort patches by released date
SORT USE IO
KILL ^TMP($JOB)
+1 SET XTBDA=0
+2 FOR
SET XTBDA=$ORDER(^XPD(9.9,XTBDA))
if 'XTBDA
QUIT
Begin DoDot:1
+3 SET XTBDTA=$GET(^XPD(9.9,XTBDA,0))
if XTBDTA=""
QUIT
+4 ;parent package missing in file
SET XTBPTNAM=$PIECE(XTBDTA,U,1)
SET XTBNMSP=$PIECE($PIECE(XTBDTA,U,4)," - ",1)
if XTBNMSP=""
QUIT
+5 SET XTBRELDT=$PIECE(XTBDTA,U,2)
SET XTBPRIOR=$PIECE(XTBDTA,U,3)
SET XTBCPLDT=$PIECE(XTBDTA,U,9)
+6 if (XTBRELDT<XTBBDT)!(XTBRELDT>XTBEDT)
QUIT
+7 SET ^TMP($JOB,XTBRELDT,XTBPTNAM,XTBDA)=XTBCPLDT_U_XTBPRIOR
End DoDot:1
PRINT ;
+1 SET Y=DT
XECUTE ^DD("DD")
SET XTBCURDT=Y
+2 KILL XTBLINE
SET $PIECE(XTBLINE,"-",(IOM-2))="-"
+3 ; first header
SET PG=0
DO HDR
+4 SET (XTBTPTCH,XTBTLATE)=0
SET XTBPTNAM=""
+5 FOR XTBRELDT=0:0
SET XTBRELDT=$ORDER(^TMP($JOB,XTBRELDT))
if XTBRELDT=""
QUIT
FOR
SET XTBPTNAM=$ORDER(^TMP($JOB,XTBRELDT,XTBPTNAM))
if XTBPTNAM=""
QUIT
Begin DoDot:1
+6 FOR XTBDA=0:0
SET XTBDA=$ORDER(^TMP($JOB,XTBRELDT,XTBPTNAM,XTBDA))
if XTBDA=""
QUIT
Begin DoDot:2
+7 SET XTBTPTCH=XTBTPTCH+1
+8 SET XTBDTA=^TMP($JOB,XTBRELDT,XTBPTNAM,XTBDA)
+9 SET XTBCPLDT=$PIECE(XTBDTA,U)
SET XTBPRIOR=$PIECE(XTBDTA,U,2)
+10 SET XTBRCVDT=$PIECE($GET(^XPD(9.9,XTBDA,0)),U,2)
+11 SET XTBPTYPE=$PIECE($GET(^XPD(9.9,XTBDA,0)),U,10)
+12 IF +XTBPTYPE=0
SET D0=XTBDA
DO ^XTPMKPCF
SET XTBINSDT=XTINST
KILL D0
+13 IF +XTBPTYPE=1
SET XTBINSDT=$PIECE($GET(^XPD(9.9,XTBDA,0)),U,11)
+14 IF XTBINSDT]""
SET X1=XTBINSDT
SET X2=XTBCPLDT
DO ^%DTC
SET XTBDAYLT=X
+15 IF XTBINSDT=""
SET X1=DT
SET X2=XTBCPLDT
DO ^%DTC
SET XTBDAYLT=X
+16 ;set date format "MON DD,YYYY"
SET Y=XTBINSDT
XECUTE ^DD("DD")
IF Y'=""
SET XTBINSDT=$PIECE(Y,",",1)_","_$EXTRACT($PIECE(Y,",",2),1,4)
+17 SET Y=XTBRELDT
XECUTE ^DD("DD")
SET XTBRELDX=Y
+18 SET Y=XTBCPLDT
XECUTE ^DD("DD")
SET XTBCPLDT=Y
+19 SET XTBPRIOR=$SELECT(XTBPRIOR="m":"Mandatory",XTBPRIOR="e":"Emergency",1:"Unknown")
+20 IF XTBVIEW=1
WRITE XTBRELDX,?14,XTBPTNAM,?27,XTBCPLDT,?41,XTBINSDT,?55,XTBPRIOR
+21 IF XTBVIEW=1
IF XTBDAYLT>0
WRITE ?67,$JUSTIFY(XTBDAYLT,3,0)_$SELECT(XTBDAYLT>1:" days",1:" day")
+22 IF XTBDAYLT>0
SET XTBTLATE=XTBTLATE+1
+23 IF XTBVIEW=1
WRITE !
IF $Y>(IOSL-6)
IF IOST?1"C-".E
DO PAUSE
if $DATA(XTBOUT)
QUIT
+24 IF XTBVIEW=1
IF $Y>(IOSL-6)
DO HDR
End DoDot:2
if $DATA(XTBOUT)
QUIT
End DoDot:1
if $DATA(XTBOUT)
QUIT
+25 if $DATA(XTBOUT)
GOTO EXIT
+26 IF $Y>(IOSL-6)
IF IOST?1"C-".E
DO HDR
+27 WRITE !!?6,"Totals patches received for date range: ",XTBTPTCH,!
+28 WRITE "Total patches installed past compliance date: ",XTBTLATE,!!
+29 SET XTBDIVOK=0
IF XTBTPTCH>0
SET XTBDIVOK=1
+30 WRITE ?25,"Delinquent patch % : ",$SELECT(XTBDIVOK=1:$JUSTIFY((XTBTLATE/XTBTPTCH*100),6,2),1:100)_" %",!
+31 WRITE ?25," Compliance % : ",$SELECT(XTBDIVOK=1:$JUSTIFY(100-(XTBTLATE/XTBTPTCH*100),6,2),1:100)," %",!
+32 IF IOST?1"C-".E
KILL XTBANS
WRITE !!,"Press ENTER to end "
READ XTBANS:DTIME
+33 ;
EXIT IF IOST?1"C-".E
WRITE @IOF,!
+1 DO ^%ZISC
+2 KILL %,%DT,%ZIS,XTBNMSP,XTBANS,XTBBDT,XTBBDT1,XTBCPLDT,XTBCPLDX,XTBDA,XTBEDT,XTBEDT1,XTBDAYLT
+3 KILL XTBINSDT,XTBLINE,XTBNMSP,XTBOLDNM,XTBNMSP,XTBPTNAM,XTBPTYPE,XTBDTA,XTBGPDA
+4 KILL XTBRCVDT,XTBTLATE,XTBTPTCH,D0,DIC,PG,POP,X,X1,X2,Y,ZTDESC,ZTIO,ZTRTN,ZTSAVE,%T,%Y
+5 KILL ^TMP($JOB),XTBOUT,XTBPGF,XTBOLGRP,ZTSK,XTBRELDT,XTBPRIOR,XTBCURDT,XTBDIVOK,XTBVIEW,XTINST
+6 QUIT
+7 ;
HDR SET PG=PG+1
IF IOST?1"P-".E
IF PG>1
WRITE @IOF
+1 IF IOST?1"C-".E
WRITE @IOF
+2 WRITE XTBCURDT
SET X="Patch Statistical Report for "_^DD("SITE")
+3 WRITE ?(IOM-$LENGTH(X)\2),X,?(IOM-12),"Page: ",PG,!,?31,"By Released Date",!
+4 SET X="Date range: "_XTBBDT1_" to "_XTBEDT1
WRITE ?(IOM-$LENGTH(X)\2),X,!
+5 WRITE !,"Release",?14,"Patch",?27,"Compliance",?41,"Install",?67,"# Days",!
+6 WRITE "Date",?14,"Number",?27,"Date",?41,"Date",?55,"Priority",?67,"Delinquent",!,XTBLINE,!
+7 QUIT
+8 ;
PAUSE if IOST'?1"C-".E
QUIT
+1 KILL XTBANS,XTBOUT
WRITE !!,"Press ENTER to continue or '^' to end "
READ XTBANS:DTIME
+2 IF XTBANS[U!('$TEST)
SET (XTBNMSP,XTBPTNAM,XTBCPLDT,XTBDA)="99999999"
SET XTBOUT=1
+3 QUIT
+4 ;
ADDOP ; Add a new option under the XUSER menu option.
+1 NEW XUA,XUB,XUC
+2 SET XUA="XTPM PATCH REPORTS"
+3 SET XUB="XTPM PATCH STATS BY RELEASED"
+4 IF $$FIND1^DIC(19,,"X",XUA,,,)
IF $$FIND1^DIC(19,,"X",XUB,,,)
SET XUC=$$ADD^XPDMENU(XUA,XUB,8,)
+5 QUIT
