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

AG71A12.m

Go to the documentation of this file. 
  1. AG71A12 ;IHS/OIT/NKD - PATIENT REGISTRATION 7.1 PATCH 12 CHECK/PRE/POST INSTALL ;
  1.  ;;7.1;PATIENT REGISTRATION;**12**;AUG 25, 2005;Build 1
  1.  ;
  1.  I '$G(DUZ) W !,"DUZ UNDEFINED OR 0." D SORRY(2) Q
  1.  ;
  1.  I '$L($G(DUZ(0))) W !,"DUZ(0) UNDEFINED OR NULL." D SORRY(2) Q
  1.  ;
  1.  S X=$P(^VA(200,DUZ,0),U)
  1.  W !!,$$CJ^XLFSTR("Hello, "_$P(X,",",2)_" "_$P(X,","),IOM)
  1.  W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_" V "_$P($T(+2),";",3)_$S($L($P($T(+2),";",5))>4:" Patch "_$P($T(+2),";",5),1:"")_".",IOM),!
  1.  ;
  1.  S:'$$VCHK("XU","8.0") XPDQUIT=2
  1.  S:'$$VCHK("DI","22.0") XPDQUIT=2
  1.  S:'$$PCHK("AG","7.1","11") XPDQUIT=2
  1.  S:'$$VCHK("AUT","98.1","28") XPDQUIT=2
  1.  S:'$$VCHK("AUPN","99.1","25") XPDQUIT=2
  1.  ;
  1.  NEW DA,DIC
  1.  S X="AG",DIC="^DIC(9.4,",DIC(0)="",D="C"
  1.  D IX^DIC
  1.  I Y<0,$D(^DIC(9.4,"C","AG")) D
  1.  . W !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM),!,$$CJ^XLFSTR("PACKAGE File with an ""AG"" prefix.",IOM)
  1.  . W !,$$CJ^XLFSTR("One entry needs to be deleted.",IOM)
  1.  . D SORRY(2)
  1.  .Q
  1.  ;
  1.  I $G(XPDQUIT) W !,$$CJ^XLFSTR("FIX IT! Before Proceeding.",IOM),!!,*7,*7,*7 Q
  1.  ;
  1.  W !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
  1.  ;
  1.  I $G(XPDENV)=1 D
  1.  . ; The following line prevents the "Disable Options..." and "Move
  1.  . ; Routines..." questions from being asked during the install.
  1.  . S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
  1.  .Q
  1.  ;
  1.  I '$$DIR^XBDIR("E","","","","","",1) D SORRY(2)
  1.  Q
  1.  ;
  1. SORRY(X) ;
  1.  KILL DIFQ
  1.  S XPDQUIT=X
  1.  W *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)
  1.  Q
  1.  ;
  1. VCHK(AGPRE,AGVER,AGPAT) ; Check patch level
  1.  N AGV,AGP
  1.  S AGV=$$VERSION^XPDUTL(AGPRE)
  1.  I (AGV<AGVER) K DIFQ D DISP(AGPRE,AGVER,$G(AGPAT),AGV,$G(AGP),0) Q 0
  1.  I '$D(AGPAT) D DISP(AGPRE,AGVER,$G(AGPAT),AGV,$G(AGP),1) Q 1
  1.  S AGP=+$$LAST(AGPRE,AGVER)
  1.  I (AGP<AGPAT) K DIFQ D DISP(AGPRE,AGVER,$G(AGPAT),AGVER,$G(AGP),0) Q 0
  1.  D DISP(AGPRE,AGVER,$G(AGPAT),AGVER,$G(AGP),1)
  1.  Q 1
  1.  ;
  1. PCHK(PKG,VER,PAT) ; Check specific patch
  1.  N PKGIEN,VERIEN,PATIEN,AGS
  1.  S PKG=$G(PKG),VER=$G(VER),PAT=$G(PAT)
  1.  S AGS="Requires "_PKG_" v"_VER_" p"_PAT_"....."
  1.  D
  1.  . S PKGIEN=+$O(^DIC(9.4,"C",PKG,"")) Q:'PKGIEN
  1.  . S VERIEN=+$O(^DIC(9.4,PKGIEN,22,"B",VER,"")) Q:'VERIEN
  1.  . S PATIEN=+$O(^DIC(9.4,PKGIEN,22,VERIEN,"PAH","B",PAT,""))
  1.  S AGS=AGS_$S(+$G(PATIEN):"Present",1:"Not found ***FIX IT***")
  1.  W !,$$CJ^XLFSTR(AGS,IOM)
  1.  Q $S(+$G(PATIEN):1,1:0)
  1.  ;
  1. DISP(AGPRE,AGVER,AGPAT,AGV,AGP,AGR) ; Display requirement checking results
  1.  ;
  1.  N AGS
  1.  S AGS="Need at least "_$G(AGPRE)_" v"_$G(AGVER)_$S($G(AGPAT)]"":" p"_$G(AGPAT),1:"")_"....."
  1.  S AGS=AGS_$G(AGPRE)_" v"_$G(AGV)_$S($G(AGP)]"":" p"_$G(AGP),1:"")_" Present"
  1.  S AGS=AGS_$S('AGR:" ***FIX IT***",1:"")
  1.  W !,$$CJ^XLFSTR(AGS,IOM)
  1.  Q
  1. LAST(PKG,VER) ; EP - returns last patch applied for a Package, PATCH^DATE
  1.  ;        Patch includes Seq # if Released
  1.  N PKGIEN,VERIEN,LATEST,PATCH,SUBIEN
  1.  I $G(VER)="" S VER=$$VERSION^XPDUTL(PKG) Q:'VER -1
  1.  S PKGIEN=$O(^DIC(9.4,"C",PKG,"")) Q:'PKGIEN -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  D
  1.  . I $P(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)>LATEST S LATEST=$P(^(0),U,2),PATCH=$P(^(0),U)
  1.  . I $P(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)=LATEST,$P(^(0),U)>PATCH S PATCH=$P(^(0),U)
  1.  Q PATCH_U_LATEST
  1.  ;
  1. PRE ; EP FR KIDS
  1.  Q
  1.  ;
  1. POST ; EP FR KIDS
  1.  Q
  1.  ;