Routine: XTPMSTA3

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

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,!

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

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,)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTPMSTA3   4529     printed  Mar 13, 2025@21:46:41                                                                                                                                                                                                    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

XTPMSTA3.m