Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XTPMNEX7

XTPMNEX7.m

Go to the documentation of this file.
  1. XTPMNEX7 ;OAK/BP - PATCHES DUE IN NEXT 7 DAYS ; 10/27/10
  1. ;;7.3;TOOLKIT;**98,100,127**; Apr 25, 1995;Build 4
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. RPT S XTBHDR="Patches Due Within Seven Days for "_^DD("SITE")
  1. S XTBBDT=3010101,X="T+7",%DT="" D ^%DT S XTBEDT=Y
  1. W @IOF,!,XTBHDR,!!! S %ZIS="MQ" D ^%ZIS G:POP EXIT
  1. I $D(IO("Q")) S ZTIO=ION,ZTRTN="RPT1^XTPMNEX7",ZTDESC=XTBHDR,ZTSAVE("XTB*")="" D ^%ZTLOAD D HOME^%ZIS
  1. I $D(ZTSK) W !,"Queued as task# ",ZTSK,!! H 2 G EXIT
  1. ;
  1. RPT1 U IO K ^TMP($J) S XTBX="",(XTBCNT,XTBLN)=0
  1. D PGBK ;page break for devices
  1. S Y=DT X ^DD("DD") S XTBRUNDT=Y
  1. F XTBX=XTBBDT:0 S XTBX=$O(^XPD(9.9,"D",XTBX)) Q:XTBX=""!(XTBX>XTBEDT) DO
  1. .F XTBDA=0:0 S XTBDA=$O(^XPD(9.9,"D",XTBX,XTBDA)) Q:XTBDA="" DO
  1. ..S XTBDTA=$G(^XPD(9.9,XTBDA,0)),XTBINST=$P(XTBDTA,U,8) Q:XTBDTA=""!(XTBINST="") ; no data or no install name
  1. ..Q:$P(XTBDTA,U,11)]"" ; non-kids install date
  1. ..S XTBXX=$O(^XPD(9.7,"B",XTBINST,9999999999),-1) I $G(^XPD(9.7,+XTBXX,2))["TEST" S XTBXX=""
  1. ..Q:$P($G(^XPD(9.7,+XTBXX,0)),U,9)=3 ; 3 = installed
  1. ..D SET
  1. S PG=0 D HDR S (XTBCPLDT,XTBPTNM,OLXTBCPL)=""
  1. I '$D(^TMP($J)) W !!,?10,"Nothing to report",! G PREXIT
  1. F S XTBCPLDT=$O(^TMP($J,XTBCPLDT)) Q:XTBCPLDT="" DO
  1. .F S XTBPTNM=$O(^TMP($J,XTBCPLDT,XTBPTNM)) Q:XTBPTNM="" DO
  1. ..F XTBLN=0:0 S XTBLN=$O(^TMP($J,XTBCPLDT,XTBPTNM,XTBLN)) Q:XTBLN="" DO
  1. ...S XTBDTA=^TMP($J,XTBCPLDT,XTBPTNM,XTBLN)
  1. ...S XTBSUBJ=$P(XTBDTA,U),XTBPRIO=$P(XTBDTA,U,2),XTBRECPT=$P(XTBDTA,U,3)
  1. ...I OLXTBCPL'=XTBCPLDT W !
  1. ...S Y=XTBCPLDT X ^DD("DD") S XTBCPLD1=Y
  1. ...W XTBCPLD1,?13,XTBPTNM,?27,XTBSUBJ,?55,XTBPRIO,?67,XTBRECPT,! S XTBCNT=XTBCNT+1
  1. ...S OLXTBCPL=XTBCPLDT
  1. ...X XTBUP
  1. X XTBUP
  1. ;
  1. PREXIT W !!,"Number of patches: ",XTBCNT,!
  1. I $E(IOST,1,2)="C-" W !,"Press RETURN to end " R ANS:DTIME I '$T Q
  1. ;
  1. EXIT D ^%ZISC
  1. K ^TMP($J),%ZIS,ANS,XTBANS,XTBCNT,XTBCPLDT,XTBDA,XTBINST,XTBLN,XTBPKG,XTBPRIO,XTBPTNM
  1. K XTBRECPT,XTBRUNDT,XTBSUBJ,XTBX,XTBXX,XTBDTA,XTBHDR,OLXTBCPL,PG,XTBPKFLV,XTBPKPTR,POP,XTBPTCVR,X,X1
  1. K Y,YY1,ZTDESC,ZTSK,ZTIO,ZTRTN,ZTSAVE,XTBCPLD1,%DT,XTBBDT,XTBEDT,XTBPSITE,XTBUP,IOP,XMY
  1. Q
  1. ;
  1. SET S XTBPTNM=$P(XTBDTA,U,1),XTBSUBJ=$E($P(XTBDTA,U,7),1,26)
  1. S X=$P(XTBDTA,U,3),XTBPRIO=$S(X="m":"Mandatory",X="e":"Emergency",1:"Unknown")
  1. S Y=$P(XTBDTA,U,2) X ^DD("DD") S XTBRECPT=Y
  1. S XTBCPLDT=$P(XTBDTA,U,9) ; compliance date
  1. S XTBLN=XTBLN+1,^TMP($J,XTBCPLDT,XTBPTNM,XTBLN)=XTBSUBJ_U_XTBPRIO_U_XTBRECPT
  1. Q
  1. ;
  1. HDR ;
  1. S PG=PG+1
  1. W !,XTBHDR," Page: ",PG,!,"Run date: ",XTBRUNDT,!!
  1. W "Compliance",!,"Date",?13,"Patch #",?27,"Subject",?55,"Priority",?67,"Recpt Date",!
  1. W "----------",?13,"-------",?27,"-------",?55,"--------",?67,"----- ----",!
  1. Q
  1. ;
  1. PAUSE W !,"Press RETURN to continue or '^' to exit: " R XTBANS:DTIME
  1. I '$T S (XTBLN,XTBCPLDT,XTBPTNM)="ZZZZZ"
  1. I XTBANS[U S (XTBLN,XTBCPLDT,XTBPTNM)="ZZZZZ"
  1. Q
  1. ;
  1. PGBK ;page break
  1. S XTBUP="I $Y>(IOSL-3) W @IOF D HDR"
  1. I $E(IOST,1,2)="C-" S XTBUP="I $Y>(IOSL-3) D PAUSE W @IOF D HDR"
  1. Q