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

XTPMKPCF.m

Go to the documentation of this file. 
  1. XTPMKPCF ;OAK/BP - COMPUTED FIELDS AND OTHER ODDITIES FOR PATCH MONITOR; ; 3/15/11 12:17pm
  1.  ;;7.3;TOOLKIT;**98,106,130**; Apr 25, 1995;Build 2
  1.  ;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ; computed fields
  1. INSTALL ; returns the patch installation information from the INSTALL file.
  1.  ; note: Fileman variables are NOT killed because they are used in output.
  1.  ; read the index backwards and select the last patch reference because TEST
  1.  ;   patches may be involved.  If a test patch, null the pointer, like nothing is there.
  1.  S X=$P($G(^XPD(9.9,D0,0)),U,8) Q:X=""
  1.  S X=$O(^XPD(9.7,"B",X,9999999999),-1) I $G(^XPD(9.7,+X,2))["TEST v" S X="" Q
  1.  S X=$P($G(^XPD(9.7,+X,1)),U,3),XTINST=$P($G(X),".",1)
  1.  I X="" Q
  1.  S Y=X D DD^%DT S X=$P(Y,"@") K Y
  1.  Q
  1.  ;
  1. WHO ; returns who installed the patch
  1.  S X=$P($G(^XPD(9.9,D0,0)),U,8) Q:X=""
  1.  S X=$O(^XPD(9.7,"B",X,9999999999),-1)  I $G(^XPD(9.7,+X,2))["TEST v" S X=""
  1.  S X=$P($G(^XPD(9.7,+X,0)),U,11)
  1.  S X=$P($G(^VA(200,+X,0)),U)
  1.  Q
  1.  ;
  1.  ; other utility items
  1.  ; patch inquiry
  1. INQUIRE S IOP="HOME" D ^%ZIS K IOP S $P(DASH,"-",75)=""
  1.  S HD="Patch Inquiry for "_^DD("SITE")
  1.  W @IOF,!,HD,!!! K DIC,X,Y
  1.  S DIC("A")="Enter PATCH NAME: ",DIC="^XPD(9.9,",DIC(0)="AEQM"
  1.  D ^DIC G:Y<0 EXITI S DA=+Y
  1.  ;
  1. LOOKUP W @IOF,! S DR="0:9",DIQ(0)="C"
  1.  S DA=+Y W @IOF,HD,!!!!!,DASH D EN1^DIQ W DASH
  1.  ;
  1. CONT W !!!,"Press RETURN to continue or '^' to exit  " R ANS:DTIME G:'$T EXITI
  1.  G:ANS[U EXITI
  1.  G INQUIRE
  1.  ;
  1. EXITI I IOST?1"C-".E W @IOF,!
  1.  ; clean up FM vars left
  1.  K %,%X,A,ANS,D0,D1,D2,DA,DIC,DIK,DL,DX,HD
  1.  K I,POP,S,DASH,DR,X,Y,DK,DIQ,IOP
  1.  Q
  1.  ;
  1. PKGLOOK ; used for free-text lookup in monitoring of namespaces
  1.  N DIC,Y,D0,DO,DA,DICR
  1.  S DIC(0)="EQM",DIC="^DIC(9.4," D ^DIC
  1.  I Y<0 K X Q
  1.  S X=$P($G(^DIC(9.4,+Y,0)),U,2) ; get package prefix
  1.  Q
  1. CMPDTCG ; Compliance Date change
  1.  K XTBCMDCG
  1.  S XTBMLN1=$G(^XMB(3.9,XMZ,0)) I XTBMLN1["COMPLIANCE DATE CHANGE" DO
  1.  .F XTBX=0:0 S XTBX=$O(^XMB(3.9,XMZ,2,XTBX)) Q:XTBX=""!(+XTBX=0)  S XTBY=$G(^XMB(3.9,XMZ,2,XTBX,0)) DO
  1.  ..I XTBY["PATCH " S XTBDESG=$P($P(XTBY,"PATCH ",2)," ",1) Q
  1.  ..I $D(XTBDESG),XTBY["The Compliance Date for patch"&(XTBY["has been changed to") DO
  1.  ...S XTBTCMPD=$P(XTBY,"has been changed to ",2)
  1.  ...S DIC(0)="M",(DIC,DIE)="^XPD(9.9,",X=XTBDESG D ^DIC I Y<0 S XTBX=9999999 Q
  1.  ...S DA=+Y,DR="8///"_XTBTCMPD D ^DIE
  1.  ...S XTBCMDCG=1
  1.  .K DR,DIC,DIE,DA,X,Y,XTBDESG,XTBTCMPD
  1.  Q
  1.  ;
  1. EXITA D ^%ZISC
  1.  K ^TMP($J)
  1.  K XTBDESG,XTBI,XTBINST,XTBINSTX,XTBPKG,XTBPRIO,XTBSEQ,XTBSUB,%ZIS,XTBANS,XTBCOMPD,XTBPURGI
  1.  K XTBVER,XTBX,XTBY,XTBZ,DIC,DIE,DO,DD,X,XMB,XMER,XMREC,XMRG,XX,XTBXX,XTBHDR,PG,POP,XTBMLN1
  1.  K XTBDA,XTBLIMIT,XTBLN,XTBPTNM,XTBRECPT,XTBRUNDT,XTBSUBJ,ZTDESC,XTBCNT
  1.  K XTBX,XTBDTA,XTBDTA,X1,X2,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,Y,XTBRCPDT,XTBMG,XTBMGN
  1.  K XTBINSDA,XTBISTAT,NOFILE,XTBPTYPE,XTBPLVER,XTBPKGPT,XTBPCTVR,YY1
  1.  K XTBX1,XTBZ,NIGHT,XTBCMPDT,ZTSK,ZTIO,ZTRTN,ZTSAVE
  1.  Q
  1.  ;
  1. INSDATE ;Print out Installed Date
  1.  N X,X1
  1.  S X=$P($G(^XPD(9.9,D0,0)),U,8) Q:X=""
  1.  S X1=$P($G(^XPD(9.9,D0,0)),U,11) I X1>0 W $$FMTE^XLFDT(X1,"2Z") Q
  1.  S X=$O(^XPD(9.7,"B",X,9999999999),-1) I $G(^XPD(9.7,+X,2))["TEST v" S X="" Q
  1.  S X=$P($G(^XPD(9.7,+X,1)),U,3) W $$FMTE^XLFDT($P(X,"."),"2Z")
  1.  Q