AG71A13 ;IHS/OIT/NKD - PATIENT REGISTRATION 7.1 PATCH 13 CHECK/PRE/POST INSTALL ;
;;7.1;PATIENT REGISTRATION;**13**;AUG 25, 2005;Build 1
;
I '$G(DUZ) W !,"DUZ UNDEFINED OR 0." D SORRY(2) Q
;
I '$L($G(DUZ(0))) W !,"DUZ(0) UNDEFINED OR NULL." D SORRY(2) Q
;
S X=$P(^VA(200,DUZ,0),U)
W !!,$$CJ^XLFSTR("Hello, "_$P(X,",",2)_" "_$P(X,","),IOM)
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),!
;
S:'$$VCHK("XU","8.0") XPDQUIT=2
S:'$$VCHK("DI","22.0") XPDQUIT=2
S:'$$PCHK("AG","7.1","12") XPDQUIT=2
;S:'$$VCHK("AUT","98.1","28") XPDQUIT=2
S:'$$VCHK("AUPN","99.1","26") XPDQUIT=2
;
NEW DA,DIC
S X="AG",DIC="^DIC(9.4,",DIC(0)="",D="C"
D IX^DIC
I Y<0,$D(^DIC(9.4,"C","AG")) D
. W !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM),!,$$CJ^XLFSTR("PACKAGE File with an ""AG"" prefix.",IOM)
. W !,$$CJ^XLFSTR("One entry needs to be deleted.",IOM)
. D SORRY(2)
.Q
;
I $G(XPDQUIT) W !,$$CJ^XLFSTR("FIX IT! Before Proceeding.",IOM),!!,*7,*7,*7 Q
;
W !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
;
I $G(XPDENV)=1 D
. ; The following line prevents the "Disable Options..." and "Move
. ; Routines..." questions from being asked during the install.
. S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
.Q
;
I '$$DIR^XBDIR("E","","","","","",1) D SORRY(2)
Q
;
SORRY(X) ;
KILL DIFQ
S XPDQUIT=X
W *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)
Q
;
VCHK(AGPRE,AGVER,AGPAT) ; Check patch level
N AGV,AGP
S AGV=$$VERSION^XPDUTL(AGPRE)
I (AGV<AGVER) K DIFQ D DISP(AGPRE,AGVER,$G(AGPAT),AGV,$G(AGP),0) Q 0
I '$D(AGPAT) D DISP(AGPRE,AGVER,$G(AGPAT),AGV,$G(AGP),1) Q 1
S AGP=+$$LAST(AGPRE,AGVER)
I (AGP<AGPAT) K DIFQ D DISP(AGPRE,AGVER,$G(AGPAT),AGVER,$G(AGP),0) Q 0
D DISP(AGPRE,AGVER,$G(AGPAT),AGVER,$G(AGP),1)
Q 1
;
PCHK(PKG,VER,PAT) ; Check specific patch
N PKGIEN,VERIEN,PATIEN,AGS
S PKG=$G(PKG),VER=$G(VER),PAT=$G(PAT)
S AGS="Requires "_PKG_" v"_VER_" p"_PAT_"....."
D
. S PKGIEN=+$O(^DIC(9.4,"C",PKG,"")) Q:'PKGIEN
. S VERIEN=+$O(^DIC(9.4,PKGIEN,22,"B",VER,"")) Q:'VERIEN
. S PATIEN=+$O(^DIC(9.4,PKGIEN,22,VERIEN,"PAH","B",PAT,""))
S AGS=AGS_$S(+$G(PATIEN):"Present",1:"Not found ***FIX IT***")
W !,$$CJ^XLFSTR(AGS,IOM)
Q $S(+$G(PATIEN):1,1:0)
;
DISP(AGPRE,AGVER,AGPAT,AGV,AGP,AGR) ; Display requirement checking results
;
N AGS
S AGS="Need at least "_$G(AGPRE)_" v"_$G(AGVER)_$S($G(AGPAT)]"":" p"_$G(AGPAT),1:"")_"....."
S AGS=AGS_$G(AGPRE)_" v"_$G(AGV)_$S($G(AGP)]"":" p"_$G(AGP),1:"")_" Present"
S AGS=AGS_$S('AGR:" ***FIX IT***",1:"")
W !,$$CJ^XLFSTR(AGS,IOM)
Q
LAST(PKG,VER) ; EP - returns last patch applied for a Package, PATCH^DATE
; Patch includes Seq # if Released
N PKGIEN,VERIEN,LATEST,PATCH,SUBIEN
I $G(VER)="" S VER=$$VERSION^XPDUTL(PKG) Q:'VER -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 LATEST=-1,PATCH=-1,SUBIEN=0
F S SUBIEN=$O(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN)) Q:SUBIEN'>0 D
. I $P(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)>LATEST S LATEST=$P(^(0),U,2),PATCH=$P(^(0),U)
. I $P(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)=LATEST,$P(^(0),U)>PATCH S PATCH=$P(^(0),U)
Q PATCH_U_LATEST
;
PRE ; EP FR KIDS
Q
;
POST ; EP FR KIDS
Q
;
AG71A13 ;IHS/OIT/NKD - PATIENT REGISTRATION 7.1 PATCH 13 CHECK/PRE/POST INSTALL ;
+1 ;;7.1;PATIENT REGISTRATION;**13**;AUG 25, 2005;Build 1
+2 ;
+3 IF '$GET(DUZ)
WRITE !,"DUZ UNDEFINED OR 0."
DO SORRY(2)
QUIT
+4 ;
+5 IF '$LENGTH($GET(DUZ(0)))
WRITE !,"DUZ(0) UNDEFINED OR NULL."
DO SORRY(2)
QUIT
+6 ;
+7 SET X=$PIECE(^VA(200,DUZ,0),U)
+8 WRITE !!,$$CJ^XLFSTR("Hello, "_$PIECE(X,",",2)_" "_$PIECE(X,","),IOM)
+9 WRITE !!,$$CJ^XLFSTR("Checking Environment for "_$PIECE($TEXT(+2),";",4)_" V "_$PIECE($TEXT(+2),";",3)_$SELECT($LENGTH($PIECE($TEXT(+2),";",5))>4:" Patch "_$PIECE($TEXT(+2),";",5),1:"")_".",IOM),!
+10 ;
+11 IF '$$VCHK("XU","8.0")
SET XPDQUIT=2
+12 IF '$$VCHK("DI","22.0")
SET XPDQUIT=2
+13 IF '$$PCHK("AG","7.1","12")
SET XPDQUIT=2
+14 ;S:'$$VCHK("AUT","98.1","28") XPDQUIT=2
+15 IF '$$VCHK("AUPN","99.1","26")
SET XPDQUIT=2
+16 ;
+17 NEW DA,DIC
+18 SET X="AG"
SET DIC="^DIC(9.4,"
SET DIC(0)=""
SET D="C"
+19 DO IX^DIC
+20 IF Y<0
IF $DATA(^DIC(9.4,"C","AG"))
Begin DoDot:1
+21 WRITE !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM),!,$$CJ^XLFSTR("PACKAGE File with an ""AG"" prefix.",IOM)
+22 WRITE !,$$CJ^XLFSTR("One entry needs to be deleted.",IOM)
+23 DO SORRY(2)
+24 QUIT
End DoDot:1
+25 ;
+26 IF $GET(XPDQUIT)
WRITE !,$$CJ^XLFSTR("FIX IT! Before Proceeding.",IOM),!!,*7,*7,*7
QUIT
+27 ;
+28 WRITE !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
+29 ;
+30 IF $GET(XPDENV)=1
Begin DoDot:1
+31 ; The following line prevents the "Disable Options..." and "Move
+32 ; Routines..." questions from being asked during the install.
+33 SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+34 QUIT
End DoDot:1
+35 ;
+36 IF '$$DIR^XBDIR("E","","","","","",1)
DO SORRY(2)
+37 QUIT
+38 ;
SORRY(X) ;
+1 KILL DIFQ
+2 SET XPDQUIT=X
+3 WRITE *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)
+4 QUIT
+5 ;
VCHK(AGPRE,AGVER,AGPAT) ; Check patch level
+1 NEW AGV,AGP
+2 SET AGV=$$VERSION^XPDUTL(AGPRE)
+3 IF (AGV<AGVER)
KILL DIFQ
DO DISP(AGPRE,AGVER,$GET(AGPAT),AGV,$GET(AGP),0)
QUIT 0
+4 IF '$DATA(AGPAT)
DO DISP(AGPRE,AGVER,$GET(AGPAT),AGV,$GET(AGP),1)
QUIT 1
+5 SET AGP=+$$LAST(AGPRE,AGVER)
+6 IF (AGP<AGPAT)
KILL DIFQ
DO DISP(AGPRE,AGVER,$GET(AGPAT),AGVER,$GET(AGP),0)
QUIT 0
+7 DO DISP(AGPRE,AGVER,$GET(AGPAT),AGVER,$GET(AGP),1)
+8 QUIT 1
+9 ;
PCHK(PKG,VER,PAT) ; Check specific patch
+1 NEW PKGIEN,VERIEN,PATIEN,AGS
+2 SET PKG=$GET(PKG)
SET VER=$GET(VER)
SET PAT=$GET(PAT)
+3 SET AGS="Requires "_PKG_" v"_VER_" p"_PAT_"....."
+4 Begin DoDot:1
+5 SET PKGIEN=+$ORDER(^DIC(9.4,"C",PKG,""))
IF 'PKGIEN
QUIT
+6 SET VERIEN=+$ORDER(^DIC(9.4,PKGIEN,22,"B",VER,""))
IF 'VERIEN
QUIT
+7 SET PATIEN=+$ORDER(^DIC(9.4,PKGIEN,22,VERIEN,"PAH","B",PAT,""))
End DoDot:1
+8 SET AGS=AGS_$SELECT(+$GET(PATIEN):"Present",1:"Not found ***FIX IT***")
+9 WRITE !,$$CJ^XLFSTR(AGS,IOM)
+10 QUIT $SELECT(+$GET(PATIEN):1,1:0)
+11 ;
DISP(AGPRE,AGVER,AGPAT,AGV,AGP,AGR) ; Display requirement checking results
+1 ;
+2 NEW AGS
+3 SET AGS="Need at least "_$GET(AGPRE)_" v"_$GET(AGVER)_$SELECT($GET(AGPAT)]"":" p"_$GET(AGPAT),1:"")_"....."
+4 SET AGS=AGS_$GET(AGPRE)_" v"_$GET(AGV)_$SELECT($GET(AGP)]"":" p"_$GET(AGP),1:"")_" Present"
+5 SET AGS=AGS_$SELECT('AGR:" ***FIX IT***",1:"")
+6 WRITE !,$$CJ^XLFSTR(AGS,IOM)
+7 QUIT
LAST(PKG,VER) ; EP - returns last patch applied for a Package, PATCH^DATE
+1 ; Patch includes Seq # if Released
+2 NEW PKGIEN,VERIEN,LATEST,PATCH,SUBIEN
+3 IF $GET(VER)=""
SET VER=$$VERSION^XPDUTL(PKG)
IF 'VER
QUIT -1
+4 SET PKGIEN=$ORDER(^DIC(9.4,"C",PKG,""))
IF 'PKGIEN
QUIT -1
+5 SET VERIEN=$ORDER(^DIC(9.4,PKGIEN,22,"B",VER,""))
IF 'VERIEN
QUIT -1
+6 SET LATEST=-1
SET PATCH=-1
SET SUBIEN=0
+7 FOR
SET SUBIEN=$ORDER(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN))
IF SUBIEN'>0
QUIT
Begin DoDot:1
+8 IF $PIECE(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)>LATEST
SET LATEST=$PIECE(^(0),U,2)
SET PATCH=$PIECE(^(0),U)
+9 IF $PIECE(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)=LATEST
IF $PIECE(^(0),U)>PATCH
SET PATCH=$PIECE(^(0),U)
End DoDot:1
+10 QUIT PATCH_U_LATEST
+11 ;
PRE ; EP FR KIDS
+1 QUIT
+2 ;
POST ; EP FR KIDS
+1 QUIT
+2 ;
