- 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 Jan 18, 2025@03:42:44 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