XTPMNEX7 ;OAK/BP - PATCHES DUE IN NEXT 7 DAYS ; 10/27/10
;;7.3;TOOLKIT;**98,100,127**; Apr 25, 1995;Build 4
;;Per VHA Directive 2004-038, this routine should not be modified.
;
RPT S XTBHDR="Patches Due Within Seven Days for "_^DD("SITE")
S XTBBDT=3010101,X="T+7",%DT="" D ^%DT S XTBEDT=Y
W @IOF,!,XTBHDR,!!! S %ZIS="MQ" D ^%ZIS G:POP EXIT
I $D(IO("Q")) S ZTIO=ION,ZTRTN="RPT1^XTPMNEX7",ZTDESC=XTBHDR,ZTSAVE("XTB*")="" 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="",(XTBCNT,XTBLN)=0
D PGBK ;page break for devices
S Y=DT X ^DD("DD") S XTBRUNDT=Y
F XTBX=XTBBDT:0 S XTBX=$O(^XPD(9.9,"D",XTBX)) Q:XTBX=""!(XTBX>XTBEDT) DO
.F XTBDA=0:0 S XTBDA=$O(^XPD(9.9,"D",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
..Q:$P(XTBDTA,U,11)]"" ; non-kids install date
..S XTBXX=$O(^XPD(9.7,"B",XTBINST,9999999999),-1) I $G(^XPD(9.7,+XTBXX,2))["TEST" S XTBXX=""
..Q:$P($G(^XPD(9.7,+XTBXX,0)),U,9)=3 ; 3 = installed
..D SET
S PG=0 D HDR S (XTBCPLDT,XTBPTNM,OLXTBCPL)=""
I '$D(^TMP($J)) W !!,?10,"Nothing to report",! G PREXIT
F S XTBCPLDT=$O(^TMP($J,XTBCPLDT)) Q:XTBCPLDT="" DO
.F S XTBPTNM=$O(^TMP($J,XTBCPLDT,XTBPTNM)) Q:XTBPTNM="" DO
..F XTBLN=0:0 S XTBLN=$O(^TMP($J,XTBCPLDT,XTBPTNM,XTBLN)) Q:XTBLN="" DO
...S XTBDTA=^TMP($J,XTBCPLDT,XTBPTNM,XTBLN)
...S XTBSUBJ=$P(XTBDTA,U),XTBPRIO=$P(XTBDTA,U,2),XTBRECPT=$P(XTBDTA,U,3)
...I OLXTBCPL'=XTBCPLDT W !
...S Y=XTBCPLDT X ^DD("DD") S XTBCPLD1=Y
...W XTBCPLD1,?13,XTBPTNM,?27,XTBSUBJ,?55,XTBPRIO,?67,XTBRECPT,! S XTBCNT=XTBCNT+1
...S OLXTBCPL=XTBCPLDT
...X XTBUP
X XTBUP
;
PREXIT W !!,"Number of patches: ",XTBCNT,!
I $E(IOST,1,2)="C-" W !,"Press RETURN to end " R ANS:DTIME I '$T Q
;
EXIT D ^%ZISC
K ^TMP($J),%ZIS,ANS,XTBANS,XTBCNT,XTBCPLDT,XTBDA,XTBINST,XTBLN,XTBPKG,XTBPRIO,XTBPTNM
K XTBRECPT,XTBRUNDT,XTBSUBJ,XTBX,XTBXX,XTBDTA,XTBHDR,OLXTBCPL,PG,XTBPKFLV,XTBPKPTR,POP,XTBPTCVR,X,X1
K Y,YY1,ZTDESC,ZTSK,ZTIO,ZTRTN,ZTSAVE,XTBCPLD1,%DT,XTBBDT,XTBEDT,XTBPSITE,XTBUP,IOP,XMY
Q
;
SET S XTBPTNM=$P(XTBDTA,U,1),XTBSUBJ=$E($P(XTBDTA,U,7),1,26)
S X=$P(XTBDTA,U,3),XTBPRIO=$S(X="m":"Mandatory",X="e":"Emergency",1:"Unknown")
S Y=$P(XTBDTA,U,2) X ^DD("DD") S XTBRECPT=Y
S XTBCPLDT=$P(XTBDTA,U,9) ; compliance date
S XTBLN=XTBLN+1,^TMP($J,XTBCPLDT,XTBPTNM,XTBLN)=XTBSUBJ_U_XTBPRIO_U_XTBRECPT
Q
;
HDR ;
S PG=PG+1
W !,XTBHDR," Page: ",PG,!,"Run date: ",XTBRUNDT,!!
W "Compliance",!,"Date",?13,"Patch #",?27,"Subject",?55,"Priority",?67,"Recpt Date",!
W "----------",?13,"-------",?27,"-------",?55,"--------",?67,"----- ----",!
Q
;
PAUSE W !,"Press RETURN to continue or '^' to exit: " R XTBANS:DTIME
I '$T S (XTBLN,XTBCPLDT,XTBPTNM)="ZZZZZ"
I XTBANS[U S (XTBLN,XTBCPLDT,XTBPTNM)="ZZZZZ"
Q
;
PGBK ;page break
S XTBUP="I $Y>(IOSL-3) W @IOF D HDR"
I $E(IOST,1,2)="C-" S XTBUP="I $Y>(IOSL-3) D PAUSE W @IOF D HDR"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTPMNEX7 3017 printed Apr 09, 2024@21:41:27 Page 2
XTPMNEX7 ;OAK/BP - PATCHES DUE IN NEXT 7 DAYS ; 10/27/10
+1 ;;7.3;TOOLKIT;**98,100,127**; Apr 25, 1995;Build 4
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
RPT SET XTBHDR="Patches Due Within Seven Days for "_^DD("SITE")
+1 SET XTBBDT=3010101
SET X="T+7"
SET %DT=""
DO ^%DT
SET XTBEDT=Y
+2 WRITE @IOF,!,XTBHDR,!!!
SET %ZIS="MQ"
DO ^%ZIS
if POP
GOTO EXIT
+3 IF $DATA(IO("Q"))
SET ZTIO=ION
SET ZTRTN="RPT1^XTPMNEX7"
SET ZTDESC=XTBHDR
SET ZTSAVE("XTB*")=""
DO ^%ZTLOAD
DO HOME^%ZIS
+4 IF $DATA(ZTSK)
WRITE !,"Queued as task# ",ZTSK,!!
HANG 2
GOTO EXIT
+5 ;
RPT1 USE IO
KILL ^TMP($JOB)
SET XTBX=""
SET (XTBCNT,XTBLN)=0
+1 ;page break for devices
DO PGBK
+2 SET Y=DT
XECUTE ^DD("DD")
SET XTBRUNDT=Y
+3 FOR XTBX=XTBBDT:0
SET XTBX=$ORDER(^XPD(9.9,"D",XTBX))
if XTBX=""!(XTBX>XTBEDT)
QUIT
Begin DoDot:1
+4 FOR XTBDA=0:0
SET XTBDA=$ORDER(^XPD(9.9,"D",XTBX,XTBDA))
if XTBDA=""
QUIT
Begin DoDot:2
+5 ; no data or no install name
SET XTBDTA=$GET(^XPD(9.9,XTBDA,0))
SET XTBINST=$PIECE(XTBDTA,U,8)
if XTBDTA=""!(XTBINST="")
QUIT
+6 ; non-kids install date
if $PIECE(XTBDTA,U,11)]""
QUIT
+7 SET XTBXX=$ORDER(^XPD(9.7,"B",XTBINST,9999999999),-1)
IF $GET(^XPD(9.7,+XTBXX,2))["TEST"
SET XTBXX=""
+8 ; 3 = installed
if $PIECE($GET(^XPD(9.7,+XTBXX,0)),U,9)=3
QUIT
+9 DO SET
End DoDot:2
End DoDot:1
+10 SET PG=0
DO HDR
SET (XTBCPLDT,XTBPTNM,OLXTBCPL)=""
+11 IF '$DATA(^TMP($JOB))
WRITE !!,?10,"Nothing to report",!
GOTO PREXIT
+12 FOR
SET XTBCPLDT=$ORDER(^TMP($JOB,XTBCPLDT))
if XTBCPLDT=""
QUIT
Begin DoDot:1
+13 FOR
SET XTBPTNM=$ORDER(^TMP($JOB,XTBCPLDT,XTBPTNM))
if XTBPTNM=""
QUIT
Begin DoDot:2
+14 FOR XTBLN=0:0
SET XTBLN=$ORDER(^TMP($JOB,XTBCPLDT,XTBPTNM,XTBLN))
if XTBLN=""
QUIT
Begin DoDot:3
+15 SET XTBDTA=^TMP($JOB,XTBCPLDT,XTBPTNM,XTBLN)
+16 SET XTBSUBJ=$PIECE(XTBDTA,U)
SET XTBPRIO=$PIECE(XTBDTA,U,2)
SET XTBRECPT=$PIECE(XTBDTA,U,3)
+17 IF OLXTBCPL'=XTBCPLDT
WRITE !
+18 SET Y=XTBCPLDT
XECUTE ^DD("DD")
SET XTBCPLD1=Y
+19 WRITE XTBCPLD1,?13,XTBPTNM,?27,XTBSUBJ,?55,XTBPRIO,?67,XTBRECPT,!
SET XTBCNT=XTBCNT+1
+20 SET OLXTBCPL=XTBCPLDT
+21 XECUTE XTBUP
End DoDot:3
End DoDot:2
End DoDot:1
+22 XECUTE XTBUP
+23 ;
PREXIT WRITE !!,"Number of patches: ",XTBCNT,!
+1 IF $EXTRACT(IOST,1,2)="C-"
WRITE !,"Press RETURN to end "
READ ANS:DTIME
IF '$TEST
QUIT
+2 ;
EXIT DO ^%ZISC
+1 KILL ^TMP($JOB),%ZIS,ANS,XTBANS,XTBCNT,XTBCPLDT,XTBDA,XTBINST,XTBLN,XTBPKG,XTBPRIO,XTBPTNM
+2 KILL XTBRECPT,XTBRUNDT,XTBSUBJ,XTBX,XTBXX,XTBDTA,XTBHDR,OLXTBCPL,PG,XTBPKFLV,XTBPKPTR,POP,XTBPTCVR,X,X1
+3 KILL Y,YY1,ZTDESC,ZTSK,ZTIO,ZTRTN,ZTSAVE,XTBCPLD1,%DT,XTBBDT,XTBEDT,XTBPSITE,XTBUP,IOP,XMY
+4 QUIT
+5 ;
SET SET XTBPTNM=$PIECE(XTBDTA,U,1)
SET XTBSUBJ=$EXTRACT($PIECE(XTBDTA,U,7),1,26)
+1 SET X=$PIECE(XTBDTA,U,3)
SET XTBPRIO=$SELECT(X="m":"Mandatory",X="e":"Emergency",1:"Unknown")
+2 SET Y=$PIECE(XTBDTA,U,2)
XECUTE ^DD("DD")
SET XTBRECPT=Y
+3 ; compliance date
SET XTBCPLDT=$PIECE(XTBDTA,U,9)
+4 SET XTBLN=XTBLN+1
SET ^TMP($JOB,XTBCPLDT,XTBPTNM,XTBLN)=XTBSUBJ_U_XTBPRIO_U_XTBRECPT
+5 QUIT
+6 ;
HDR ;
+1 SET PG=PG+1
+2 WRITE !,XTBHDR," Page: ",PG,!,"Run date: ",XTBRUNDT,!!
+3 WRITE "Compliance",!,"Date",?13,"Patch #",?27,"Subject",?55,"Priority",?67,"Recpt Date",!
+4 WRITE "----------",?13,"-------",?27,"-------",?55,"--------",?67,"----- ----",!
+5 QUIT
+6 ;
PAUSE WRITE !,"Press RETURN to continue or '^' to exit: "
READ XTBANS:DTIME
+1 IF '$TEST
SET (XTBLN,XTBCPLDT,XTBPTNM)="ZZZZZ"
+2 IF XTBANS[U
SET (XTBLN,XTBCPLDT,XTBPTNM)="ZZZZZ"
+3 QUIT
+4 ;
PGBK ;page break
+1 SET XTBUP="I $Y>(IOSL-3) W @IOF D HDR"
+2 IF $EXTRACT(IOST,1,2)="C-"
SET XTBUP="I $Y>(IOSL-3) D PAUSE W @IOF D HDR"
+3 QUIT
