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

XPDUTL.m

Go to the documentation of this file. 
  1. XPDUTL ;SFISC/RSD - KIDS utilities ;10/15/2008
  1.  ;;8.0;KERNEL;**21,28,39,81,100,108,137,181,275,491,511,559,1018**;Jul 10, 1995;Build 8
  1.  ;Per VHA Directive 2004-038, this routine should not be modified.
  1.  Q
  1. VERSION(X) ;Get current version from Package file, X=package name or
  1.  ;package namespace
  1.  N I
  1.  S I=$$LKPKG(X) Q:'I ""
  1.  Q $P($G(^DIC(9.4,+I,"VERSION")),"^")
  1.  ;
  1. VER(X) ;returns version number from Build file, X=build name
  1.  Q:X["*" $P(X,"*",2)
  1.  Q $P(X," ",$L(X," "))
  1.  ;
  1. STATUS(IEN) ;returns status from Install File, IEN=Install File IEN
  1.  I '$D(^XPD(9.7,IEN,0)) Q -1
  1.  Q $P(^XPD(9.7,IEN,0),U,9)
  1.  ;
  1. PKG(X) ;returns package name from Build file, X=build name
  1.  Q $S(X["*":$P(X,"*"),1:$P(X," ",1,$L(X," ")-1))
  1.  ;
  1. LAST(PKG,VER,REL) ;returns last patch applied for a Package, PATCH^DATE
  1.  ;PKG=package name, VER=version number, REL[optional]=1 if you want released patches only
  1.  ;Patch includes Seq # if Released
  1.  N PKGIEN,VERIEN,LATEST,PATCH,SUBIEN,Y
  1.  S PKGIEN=$$LKPKG($G(PKG)) Q:'PKGIEN -1
  1.  I $G(VER)="" S VER=$P($G(^DIC(9.4,PKGIEN,"VERSION")),"^") Q:'VER -1
  1.  S VERIEN=$O(^DIC(9.4,PKGIEN,22,"B",VER,"")) Q:'VERIEN -1
  1.  S LATEST=-1,PATCH=-1,SUBIEN=0
  1.  F  S SUBIEN=$O(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN)) Q:SUBIEN'>0  S Y=$G(^(SUBIEN,0)) D:$P(Y,U,2)>LATEST
  1.  . I $G(REL),$P(Y,U)'["SEQ #" Q  ;released only, must contain SEQ
  1.  . S LATEST=$P(Y,U,2),PATCH=$P(Y,U)
  1.  Q PATCH_U_LATEST
  1.  ;
  1. PATCH(X) ;return 1 if patch X was installed, X=aaaa*nn.nn*nnn
  1.  ;Q:X'?1.4UN1"*"1.2N1"."1.2N.1(1"V",1"T").2N1"*"1.3N 0  ;XU*8.0*1018 - IHS/OIT/FBD - ORIGINAL LINE - COMMENTED OUT
  1.  Q:X'?1.4UN1"*"1.2N1"."1.2N.1(1"V",1"T").2N1"*"1.6N 0  ;XU*8.0*1018 - IHS/OIT/FBD - EXPAND PATCH FORMAT TO aaaa*nn.nn*nnnnnn
  1.  N %,I,J
  1.  S I=$$LKPKG($P(X,"*")) Q:'I 0
  1.  S J=$O(^DIC(9.4,I,22,"B",$P(X,"*",2),0)),X=$P(X,"*",3) Q:'J 0
  1.  ;check if patch is just a number
  1.  Q:$O(^DIC(9.4,I,22,J,"PAH","B",X,0)) 1
  1.  S %=$O(^DIC(9.4,I,22,J,"PAH","B",X_" SEQ"))
  1.  Q (X=+%)
  1.  ;
  1. INSTALDT(INSTALL,RESULT) ;returns number of installs, 0 if not installed or doesn't exist
  1.  ;input: INSTALL=required, Install name; RESULT=required, passed by reference
  1.  ;output: RESULT=number in RESULT array; RESULT(FM date/time)=TEST# ^ SEQ#
  1.  N CNT,DATE,IEN
  1.  K RESULT
  1.  S (IEN,CNT,RESULT)=0
  1.  I $G(INSTALL)="" Q 0
  1.  F  S IEN=$O(^XPD(9.7,"B",INSTALL,IEN)) Q:'IEN  D
  1.  .S DATE=$P($G(^XPD(9.7,IEN,1)),U,3) Q:'DATE
  1.  .S RESULT(DATE)=$G(^XPD(9.7,IEN,6)),CNT=CNT+1
  1.  S RESULT=CNT
  1.  Q CNT
  1.  ;
  1. NEWCP(XPD,XPDC,XPDP) ;create new check point, returns 0=error or ien
  1.  ;XPD=name, XPDC=call back, XPDP=parameters
  1.  Q:$G(XPD)="" 0
  1.  N %,XPDI,XPDJ,XPDF,XPDY
  1.  ;XPDCP="INI"=Pre-init, "INIT"=Post-init
  1.  S XPDI=$S(XPDCP="INIT":9.716,1:9.713)
  1.  S %=$$FIND1^DIC(XPDI,","_XPDA_",","X",XPD) Q:% %
  1.  S XPDF="+1,"_XPDA_",",XPDJ(XPDI,XPDF,.01)=XPD
  1.  S:$D(XPDC) XPDJ(XPDI,XPDF,2)=XPDC
  1.  S:$D(XPDP) XPDJ(XPDI,XPDF,3)=XPDP
  1.  D UPDATE^DIE("","XPDJ","XPDY")
  1.  Q $G(XPDY(1))
  1.  ;
  1. UPCP(XPD,XPDP) ;update check point, returns 0=error or ien
  1.  ;XPD=name, XPDP=parameters
  1.  N XPDI,XPDJ,XPDF,XPDY
  1.  ;XPDCP="INI"=Pre-init, "INIT"=Post-init
  1.  S XPDI=$S(XPDCP="INIT":9.716,1:9.713),XPDY=$$DICCP($G(XPD))
  1.  Q:'XPDY 0
  1.  S XPDF=XPDY_","_XPDA_","
  1.  S:$D(XPDP) XPDJ(XPDI,XPDF,3)=XPDP
  1.  D FILE^DIE("","XPDJ")
  1.  Q XPDY
  1.  ;
  1. COMCP(XPD) ;complete check point, returns 0=error or date/time
  1.  ;XPD=name
  1.  N XPDD,XPDI,XPDJ,XPDY
  1.  S XPDI=$S(XPDCP="INIT":9.716,1:9.713),XPDY=$$DICCP($G(XPD))
  1.  Q:'XPDY 0
  1.  S XPDD=$$NOW^XLFDT,XPDJ(XPDI,XPDY_","_XPDA_",",1)=XPDD
  1.  D FILE^DIE("","XPDJ")
  1.  Q XPDD
  1.  ;
  1. VERCP(XPD) ;verify check point, returns 1=completed, 0=not
  1.  ;-1=doesn't exist
  1.  ;XPD=name
  1.  N XPDI,XPDY
  1.  S XPDI=$S(XPDCP="INIT":9.716,1:9.713),XPDY=$$DICCP($G(XPD))
  1.  Q:'XPDY -1
  1.  Q ''$$GET1^DIQ(XPDI,XPDY_","_XPDA_",",1,"I")
  1.  ;
  1. PARCP(XPD,XPDF) ;returns parameters of check point
  1.  ;XPD=name, XPDF="PRE"
  1.  N XPDI,XPDY
  1.  I $G(XPDF)="PRE" N XPDCP S XPDCP="INI"
  1.  S XPDI=$S(XPDCP="INIT":9.716,1:9.713),XPDY=$$DICCP($G(XPD))
  1.  Q:'XPDY 0
  1.  Q $$GET1^DIQ(XPDI,XPDY_","_XPDA_",",3,"I")
  1.  ;
  1. CURCP(XPDF) ;returns current check point
  1.  ;XPDF flag - 0=externel, 1=internal
  1.  Q $S($G(XPDF):XPDCHECK,1:XPDCHECK(0))
  1.  ;
  1. WP(X) ;X=global ref
  1.  N %
  1.  Q:'$D(@X)
  1.  F %=1:1 Q:'$D(@X@(%))  W !,@X@(%)
  1.  Q:'$G(XPDA)  D WP^DIE(9.7,XPDA_",",20,"A",X)
  1.  Q
  1. MES(X) ;record message, X=message or an array passed by reference
  1.  N %
  1.  I $D(X)#2 S %=X K X S X(1)=%
  1.  ;write message
  1.  F %=1:1 Q:'$D(X(%))  W !,X(%)
  1.  Q:'$G(XPDA)  D WP^DIE(9.7,XPDA_",",20,"A","X")
  1.  Q
  1. BMES(X) ;add blank line before message
  1.  N %
  1.  I $D(X)#2 S %=X K X S X(1)=" ",X(2)=%
  1.  D MES(.X)
  1.  Q
  1. RTNUP(X,Y) ;update routine action, X=routine, Y=action
  1.  ;actions:  1=delete, 2=skip
  1.  N %
  1.  ;set action to Y
  1.  Q:'$G(Y)!'$D(^XTMP("XPDI",$G(XPDA),"RTN",X)) 0 S $P(^(X),U)=+Y
  1.  Q 1
  1.  ;get Build ien
  1.  S Y=$O(^XTMP("XPDI",XPDA,"BLD",0))
  1.  ;remove checksum when updating action, since action can only be
  1.  ;delete or skip, not sure if we want to do this
  1.  S:$P(%,U,2) $P(^XTMP("XPDI",XPDA,"BLD",Y,"KRN",9.8,"NM",$P(%,U,2),0),U,4)=""
  1.  Q 1
  1.  ;
  1. RTNLOG(X) ;Enter/Update routine in the Routine File
  1.  N Y,FDA,IEN
  1.  S Y=$O(^DIC(9.8,"B",X,0))
  1.  I Y'>0 S IEN="?+1,",FDA(9.8,IEN,1)="R"
  1.  I Y>0 S IEN=(+Y)_","
  1.  S FDA(9.8,IEN,.01)=X,FDA(9.8,IEN,7.4)=$$NOW^XLFDT
  1.  D UPDATE^DIE("","FDA","IEN")
  1.  Q
  1.  ;
  1. DICCP(X) ;lookup check point, returns ien or 0
  1.  Q:$G(X)="" 0
  1.  ;if they pass ien, fail if can't find
  1.  I X=+X S Y=X Q:'$D(^XPD(9.7,XPDA,XPDCP,Y,0)) 0
  1.  E  S Y=$$FIND1^DIC(XPDI,","_XPDA_",","X",X)
  1.  Q Y
  1.  ;
  1. PRODE(XPDN,XPD) ;enable/disable protocols, return 1 for success
  1.  ;XPDN=protocol name, XPD=1-enable, 0-disable
  1.  Q:$G(XPDN)="" 0
  1.  S XPD=+$G(XPD)
  1.  D KIDS^XQOO1($P(XPDSET,U,2),101,XPDN,.XPD)
  1.  Q $S(XPD<0:0,1:1)
  1.  ;
  1. OPTDE(XPDN,XPD) ;enable/disable options, return 1 for success
  1.  ;XPDN=protocol name, XPD=1-enable, 0-disable
  1.  Q:$G(XPDN)="" 0
  1.  S XPD=+$G(XPD)
  1.  D KIDS^XQOO1($P(XPDSET,U,2),19,XPDN,.XPD)
  1.  Q $S(XPD<0:0,1:1)
  1.  ;
  1. BUILD(XPDN,XPD) ;check if a build exists, return 1 for success
  1.  ;XPDN=build name, XPD=1-exist, 0-been removed
  1.  S XPD=$D(XPDT("NM",XPDN))
  1.  Q XPD
  1.  ;
  1. MAILGRP(X) ;Return mail group for package, X=package name or namespace
  1.  N XD,DIC,DR,DA,DIQ
  1.  S DA=$$LKPKG(X) Q:'DA ""
  1.  S DIC="^DIC(9.4,",DR=1938,DIQ="XD" D EN^DIQ1
  1.  Q $S($G(XD(9.4,DA,1938))="":"",1:"G."_XD(9.4,DA,1938))
  1.  ;
  1. LKPKG(X) ;Return Package ien,  X=package name or namespace
  1.  Q:$G(X)="" 0
  1.  N DA
  1.  I $L(X)<5 D  Q:DA +DA
  1.  .S DA=$O(^DIC(9.4,"C",X,0))
  1.  .S:'DA DA=$O(^DIC(9.4,"C2",X,0))
  1.  I $L(X)>3 S DA=$O(^DIC(9.4,"B",X,0))
  1.  Q +DA