BARENVCK ;IHS/SD/POT - ENVIRONMENT CHECKER ;
;;1.8;IHS ACCOUNTS RECEIVABLE;**8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28**;OCT 26,2005;Build 92
;vc; Version BARENVCK.INT/BAR.1 Date 25-Oct-17 By User Location BAR$M
;vc; Component name INT.BARENVCK Routine name: BARENVCK
;IHS/SD/POT - BAR*1.8*25 - checker to look for latest patches
;IHS/SD/SDR - 1.8*26 - Updated for patch 26; changed all namespacing of variable from ABM to BAR
;IHS/DIT/CPC - BAR*1.8*27 - Updated for patch 27;
;IHS/DIT/CPC - BAR*1.8*28 - Updated for patch 28;
;
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)_" Patch "_$P($T(+2),";",5)_".",IOM),!
;
S XPDQUIT=0
;
I '$$VCHK("DI","22.0",2) S XPDQUIT=2
;
S X=$$PATCH^XPDUTL("DI*22.0*1017")
I X'=1 W !,$$CJ^XLFSTR("VA Fileman 22 Patch 1017 NOT INSTALLED",IOM) S XPDQUIT=2
I X=1 W !,$$CJ^XLFSTR("VA Fileman 22 Patch 1017 installed.",IOM)
K X
;
I '$$VCHK("ABM","2.6",2) S XPDQUIT=2
N X,BAR,I
S BAR=1
F I=1:1:22 D
.S X=$$PATCH^XPDUTL("ABM*2.6*"_I)
.I X'=1 S BAR=0 W !,$$CJ^XLFSTR("Need Third Party Billing v2.6 Patch "_I_"..... "_$S(BAR=0:"NOT ",1:"")_"Present",IOM)
I BAR=0 S XPDQUIT=2
;
;START NEW CODE- BAR*1.8*25 IHS/SD/POT
I '$$VCHK("BAR","1.8",2) S XPDQUIT=2
S BAR=1
;F I=9:1:24 D ;bar*1.8*26 IHS/SD/SDR
F I=6:1:7,9,10,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27 D ;bar*1.8*28 IHS/DIT/CPC
.S X=$$PATCH^XPDUTL("BAR*1.8*"_I)
.I X'=1 S BAR=0 W !,$$CJ^XLFSTR("Need A/R v1.8 Patch "_I_"..... "_$S(BAR=0:"NOT ",1:"")_"Present",IOM)
I BAR=0 S XPDQUIT=2
;end NEW CODE- BAR*1.8*25 IHS/SD/POT
;
I '$$VCHK("AUT","98.1",2) S XPDQUIT=2
;
S X=$$LAST^BARENVCK("IHS DICTIONARIES (POINTERS)","98.1")
;old code I $P(X,U,1)'=14&($P(X,U,1)'>14) W !,$$CJ^XLFSTR("AUT v98.1 Patch 14 NOT INSTALLED",IOM) S XPDQUIT=2 - BAR*1.8*25 IHS/SD/POT
I $P(X,U,1)'=26&($P(X,U,1)'>26) W !,$$CJ^XLFSTR("AUT v98.1 Patch 26 NOT INSTALLED",IOM) S XPDQUIT=2 ;- BAR*1.8*25 IHS/SD/POT
;
I '$$VCHK("XU","8.0",2) S XPDQUIT=2
K X
;NEW CODE- BAR*1.8*25 IHS/SD/POT
S X=$$PATCH^XPDUTL("XU*8.0*1017")
I X'=1 W !,$$CJ^XLFSTR("KERNEL v8.0 Patch 1017 NOT INSTALLED",IOM) S XPDQUIT=2
I X=1 W !,$$CJ^XLFSTR("XU Patch 1017 installed.",IOM)
K X
;end NEW CODE- BAR*1.8*25 ;IHS/SD/POT
;
;NEW CODE - BAR*1.8*27 ;IHS/DIT/CPC
S X=$$PATCH^XPDUTL("AUPN*99.1*26") ; NOT TESTABLE AT CREATION
I X'=1 W !,$$CJ^XLFSTR("IHS DICTIONARIES V99.1 PAT 26 NOT INSTALLED",IOM) S XPDQUIT=2
I X=1 W !,$$CJ^XLFSTR("IHS DICTIONARIES V99.1 PAT 26 INSTALLED",IOM)
K X
;end NEW CODE - BAR*1.8*27 ;IHS/DIT/CPC
;
N DA,DIC
S X="BAR",DIC="^DIC(9.4,",DIC(0)="",D="C"
D IX^DIC
I Y<0,$D(^DIC(9.4,"C","BAR")) D S XPDQUIT=2
.W !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM),!,$$CJ^XLFSTR("PACKAGE File with an ""BAR"" prefix.",IOM)
.W !,$$CJ^XLFSTR("One entry needs to be deleted.",IOM)
.W !,$$CJ^XLFSTR("FIX IT! Before Proceeding.",IOM),!!,*7,*7,*7
.Q
;
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
.D OPTSAV("BARMENU")
.Q
;
I XPDQUIT D SORRY(XPDQUIT) Q
;
W !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
;
I '$$DIR^XBDIR("E","","","","","",1) D SORRY(2) Q
Q
;
SORRY(X) ;
KILL DIFQ
S XPDQUIT=X
W:'$D(ZTQUEUED) *7,!,$$CJ^XLFSTR("Sorry....",IOM),$$DIR^XBDIR("E","Press RETURN")
Q
;
VCHK(BARPRE,BARVER,BARQUIT) ; Check versions needed.
;
N BARV
S BARV=$$VERSION^XPDUTL(BARPRE)
W !,$$CJ^XLFSTR("Need at least "_BARPRE_" v "_BARVER_"....."_BARPRE_" v "_BARV_" Present",IOM)
I BARV<BARVER W *7,!,$$CJ^XLFSTR("^^^^**NEEDS FIXED**^^^^",IOM) Q 0
Q 1
;
OPTSAV(BARM) ;
D BMES^XPDUTL("Saving the configuration of option '"_BARM_"'...")
I $D(^XTMP("BARENVCK",7.2,"OPTSAV",DT,BARM)) D BMES^XPDUTL("NOT SAVED. Option '"_BARM_"' has previously been saved.") Q
I '$D(^XTMP("BARENVCK")) S ^XTMP("BARENVCK",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"BARENVCK - SAVE OPTION CONFIGURATIONS."
N I,A
S I=$O(^DIC(19,"B",BARM,0))
I 'I D BMES^XPDUTL("NOT SAVED. Option '"_BARM_"' not found in OPTION file.") Q
S A=0
F S A=$O(^DIC(19,I,10,A)) Q:'A S ^XTMP("BARENVCK",7.2,"OPTSAV",DT,BARM,A)=$P(^DIC(19,+^DIC(19,I,10,A,0),0),U,1)_U_$P(^DIC(19,I,10,A,0),U,2,3)
Q
;
INSTALLD(BARINSTL) ;EP - Determine if patch ABMINSTL was installed, where ABMINSTL is
; the name of the INSTALL. E.g "ABM*2.5*6".
;;^DIC(9.4,D0,22,D1,PAH,D2,0)=
;;(#.01) PATCH APPLICATION HISTORY [1F] ^ (#.02)DATE APPLIED [2D] ^ (#.03) APPLIED BY [3P] ^
N DIC,X,Y
S X=$P(BARINSTL,"*",1)
S DIC="^DIC(9.4,",DIC(0)="FM",D="C"
D IX^DIC
I Y<1 Q 0
S DIC=DIC_+Y_",22,",X=$P(BARINSTL,"*",2)
D ^DIC
I Y<1 Q 0
S DIC=DIC_+Y_",""PAH"",",X=$P(BARINSTL,"*",3)
D ^DIC
Q $S(Y<1:0,1:1)
;
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,"B",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
BARENVCK ;IHS/SD/POT - ENVIRONMENT CHECKER ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28**;OCT 26,2005;Build 92
+2 ;vc; Version BARENVCK.INT/BAR.1 Date 25-Oct-17 By User Location BAR$M
+3 ;vc; Component name INT.BARENVCK Routine name: BARENVCK
+4 ;IHS/SD/POT - BAR*1.8*25 - checker to look for latest patches
+5 ;IHS/SD/SDR - 1.8*26 - Updated for patch 26; changed all namespacing of variable from ABM to BAR
+6 ;IHS/DIT/CPC - BAR*1.8*27 - Updated for patch 27;
+7 ;IHS/DIT/CPC - BAR*1.8*28 - Updated for patch 28;
+8 ;
+9 IF '$GET(DUZ)
WRITE !,"DUZ UNDEFINED OR 0."
DO SORRY(2)
QUIT
+10 ;
+11 IF '$LENGTH($GET(DUZ(0)))
WRITE !,"DUZ(0) UNDEFINED OR NULL."
DO SORRY(2)
QUIT
+12 ;
+13 SET X=$PIECE(^VA(200,DUZ,0),U)
+14 WRITE !!,$$CJ^XLFSTR("Hello, "_$PIECE(X,",",2)_" "_$PIECE(X,","),IOM)
+15 WRITE !!,$$CJ^XLFSTR("Checking Environment for "_$PIECE($TEXT(+2),";",4)_" V "_$PIECE($TEXT(+2),";",3)_" Patch "_$PIECE($TEXT(+2),";",5)_".",IOM),!
+16 ;
+17 SET XPDQUIT=0
+18 ;
+19 IF '$$VCHK("DI","22.0",2)
SET XPDQUIT=2
+20 ;
+21 SET X=$$PATCH^XPDUTL("DI*22.0*1017")
+22 IF X'=1
WRITE !,$$CJ^XLFSTR("VA Fileman 22 Patch 1017 NOT INSTALLED",IOM)
SET XPDQUIT=2
+23 IF X=1
WRITE !,$$CJ^XLFSTR("VA Fileman 22 Patch 1017 installed.",IOM)
+24 KILL X
+25 ;
+26 IF '$$VCHK("ABM","2.6",2)
SET XPDQUIT=2
+27 NEW X,BAR,I
+28 SET BAR=1
+29 FOR I=1:1:22
Begin DoDot:1
+30 SET X=$$PATCH^XPDUTL("ABM*2.6*"_I)
+31 IF X'=1
SET BAR=0
WRITE !,$$CJ^XLFSTR("Need Third Party Billing v2.6 Patch "_I_"..... "_$SELECT(BAR=0:"NOT ",1:"")_"Present",IOM)
End DoDot:1
+32 IF BAR=0
SET XPDQUIT=2
+33 ;
+34 ;START NEW CODE- BAR*1.8*25 IHS/SD/POT
+35 IF '$$VCHK("BAR","1.8",2)
SET XPDQUIT=2
+36 SET BAR=1
+37 ;F I=9:1:24 D ;bar*1.8*26 IHS/SD/SDR
+38 ;bar*1.8*28 IHS/DIT/CPC
FOR I=6:1:7,9,10,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27
Begin DoDot:1
+39 SET X=$$PATCH^XPDUTL("BAR*1.8*"_I)
+40 IF X'=1
SET BAR=0
WRITE !,$$CJ^XLFSTR("Need A/R v1.8 Patch "_I_"..... "_$SELECT(BAR=0:"NOT ",1:"")_"Present",IOM)
End DoDot:1
+41 IF BAR=0
SET XPDQUIT=2
+42 ;end NEW CODE- BAR*1.8*25 IHS/SD/POT
+43 ;
+44 IF '$$VCHK("AUT","98.1",2)
SET XPDQUIT=2
+45 ;
+46 SET X=$$LAST^BARENVCK("IHS DICTIONARIES (POINTERS)","98.1")
+47 ;old code I $P(X,U,1)'=14&($P(X,U,1)'>14) W !,$$CJ^XLFSTR("AUT v98.1 Patch 14 NOT INSTALLED",IOM) S XPDQUIT=2 - BAR*1.8*25 IHS/SD/POT
+48 ;- BAR*1.8*25 IHS/SD/POT
IF $PIECE(X,U,1)'=26&($PIECE(X,U,1)'>26)
WRITE !,$$CJ^XLFSTR("AUT v98.1 Patch 26 NOT INSTALLED",IOM)
SET XPDQUIT=2
+49 ;
+50 IF '$$VCHK("XU","8.0",2)
SET XPDQUIT=2
+51 KILL X
+52 ;NEW CODE- BAR*1.8*25 IHS/SD/POT
+53 SET X=$$PATCH^XPDUTL("XU*8.0*1017")
+54 IF X'=1
WRITE !,$$CJ^XLFSTR("KERNEL v8.0 Patch 1017 NOT INSTALLED",IOM)
SET XPDQUIT=2
+55 IF X=1
WRITE !,$$CJ^XLFSTR("XU Patch 1017 installed.",IOM)
+56 KILL X
+57 ;end NEW CODE- BAR*1.8*25 ;IHS/SD/POT
+58 ;
+59 ;NEW CODE - BAR*1.8*27 ;IHS/DIT/CPC
+60 ; NOT TESTABLE AT CREATION
SET X=$$PATCH^XPDUTL("AUPN*99.1*26")
+61 IF X'=1
WRITE !,$$CJ^XLFSTR("IHS DICTIONARIES V99.1 PAT 26 NOT INSTALLED",IOM)
SET XPDQUIT=2
+62 IF X=1
WRITE !,$$CJ^XLFSTR("IHS DICTIONARIES V99.1 PAT 26 INSTALLED",IOM)
+63 KILL X
+64 ;end NEW CODE - BAR*1.8*27 ;IHS/DIT/CPC
+65 ;
+66 NEW DA,DIC
+67 SET X="BAR"
SET DIC="^DIC(9.4,"
SET DIC(0)=""
SET D="C"
+68 DO IX^DIC
+69 IF Y<0
IF $DATA(^DIC(9.4,"C","BAR"))
Begin DoDot:1
+70 WRITE !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM),!,$$CJ^XLFSTR("PACKAGE File with an ""BAR"" prefix.",IOM)
+71 WRITE !,$$CJ^XLFSTR("One entry needs to be deleted.",IOM)
+72 WRITE !,$$CJ^XLFSTR("FIX IT! Before Proceeding.",IOM),!!,*7,*7,*7
+73 QUIT
End DoDot:1
SET XPDQUIT=2
+74 ;
+75 IF $GET(XPDENV)=1
Begin DoDot:1
+76 ; The following line prevents the "Disable Options..." and "Move
+77 ; Routines..." questions from being asked during the install.
+78 SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+79 DO OPTSAV("BARMENU")
+80 QUIT
End DoDot:1
+81 ;
+82 IF XPDQUIT
DO SORRY(XPDQUIT)
QUIT
+83 ;
+84 WRITE !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
+85 ;
+86 IF '$$DIR^XBDIR("E","","","","","",1)
DO SORRY(2)
QUIT
+87 QUIT
+88 ;
SORRY(X) ;
+1 KILL DIFQ
+2 SET XPDQUIT=X
+3 IF '$DATA(ZTQUEUED)
WRITE *7,!,$$CJ^XLFSTR("Sorry....",IOM),$$DIR^XBDIR("E","Press RETURN")
+4 QUIT
+5 ;
VCHK(BARPRE,BARVER,BARQUIT) ; Check versions needed.
+1 ;
+2 NEW BARV
+3 SET BARV=$$VERSION^XPDUTL(BARPRE)
+4 WRITE !,$$CJ^XLFSTR("Need at least "_BARPRE_" v "_BARVER_"....."_BARPRE_" v "_BARV_" Present",IOM)
+5 IF BARV<BARVER
WRITE *7,!,$$CJ^XLFSTR("^^^^**NEEDS FIXED**^^^^",IOM)
QUIT 0
+6 QUIT 1
+7 ;
OPTSAV(BARM) ;
+1 DO BMES^XPDUTL("Saving the configuration of option '"_BARM_"'...")
+2 IF $DATA(^XTMP("BARENVCK",7.2,"OPTSAV",DT,BARM))
DO BMES^XPDUTL("NOT SAVED. Option '"_BARM_"' has previously been saved.")
QUIT
+3 IF '$DATA(^XTMP("BARENVCK"))
SET ^XTMP("BARENVCK",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"BARENVCK - SAVE OPTION CONFIGURATIONS."
+4 NEW I,A
+5 SET I=$ORDER(^DIC(19,"B",BARM,0))
+6 IF 'I
DO BMES^XPDUTL("NOT SAVED. Option '"_BARM_"' not found in OPTION file.")
QUIT
+7 SET A=0
+8 FOR
SET A=$ORDER(^DIC(19,I,10,A))
IF 'A
QUIT
SET ^XTMP("BARENVCK",7.2,"OPTSAV",DT,BARM,A)=$PIECE(^DIC(19,+^DIC(19,I,10,A,0),0),U,1)_U_$PIECE(^DIC(19,I,10,A,0),U,2,3)
+9 QUIT
+10 ;
INSTALLD(BARINSTL) ;EP - Determine if patch ABMINSTL was installed, where ABMINSTL is
+1 ; the name of the INSTALL. E.g "ABM*2.5*6".
+2 ;;^DIC(9.4,D0,22,D1,PAH,D2,0)=
+3 ;;(#.01) PATCH APPLICATION HISTORY [1F] ^ (#.02)DATE APPLIED [2D] ^ (#.03) APPLIED BY [3P] ^
+4 NEW DIC,X,Y
+5 SET X=$PIECE(BARINSTL,"*",1)
+6 SET DIC="^DIC(9.4,"
SET DIC(0)="FM"
SET D="C"
+7 DO IX^DIC
+8 IF Y<1
QUIT 0
+9 SET DIC=DIC_+Y_",22,"
SET X=$PIECE(BARINSTL,"*",2)
+10 DO ^DIC
+11 IF Y<1
QUIT 0
+12 SET DIC=DIC_+Y_",""PAH"","
SET X=$PIECE(BARINSTL,"*",3)
+13 DO ^DIC
+14 QUIT $SELECT(Y<1:0,1:1)
+15 ;
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,"B",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
