BAREV18 ; IHS/SD/LSL - ENVIRONMENT CHECK V1.8 ;
;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
;
;IHS/SD/RLT - 04/05/05
; Modified routine to use PATCH^XPDUTL in the INSTALLD tag
;
I '$G(DUZ) D Q
. W !,"DUZ UNDEFINED OR 0."
. D SORRY(2)
;
I '$L($G(DUZ(0))) D Q
. W !,"DUZ(0) UNDEFINED OR NULL."
. D SORRY(2)
;
S X=$P(^VA(200,DUZ,0),U) ; User's name
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),IOM)
;
;I $$VCHK("XU","8.0",2) ; Kernel V8.0
N BARXU
;S BARXU=$$INSTALLD("XU") ;RLT ; Find current Kernel version and patch
S BARXU=$$INSTALLD("XU","8.0",1011) ;RLT ; Find current Kernel version and patch
I $P(BARXU,"*",2)<8 S BARXU=0
I $P(BARXU,"*",3)'=1 S BARXU=0 ;RLT
;I $P(BARXU,"*",2)>7,$P(BARXU,"*",2)<9,$P(BARXU,"*",3)<1010 S BARXU=0 ;RLT
W !,$$CJ^XLFSTR("Need at least XU v8.0 Patch 1011..... "_$S(BARXU=0:"NOT ",1:"")_"Present",IOM)
I BARXU=0 D SORRY(2)
;
I $$VCHK("DI","21.0",2) ; FileMan V21.0
;
N BARXB
;S BARXB=$$INSTALLD("XB") ;RLT ; Find current IHS utilities version and patch
S BARXB=$$INSTALLD("XB","3.0",11) ;RLT ; Find current IHS utilities version and patch
I $P(BARXB,"*",2)<3 S BARXB=0
I $P(BARXU,"*",3)'=1 S BARXU=0 ;RLT
;I $P(BARXB,"*",2)>2,$P(BARXB,"*",2)<4,$P(BARXB,"*",3)<10 S BARXB=0 ;RLT
W !,$$CJ^XLFSTR("Need at least XB v3.0 Patch 11..... "_$S(BARXB=0:"NOT ",1:"")_"Present",IOM)
I BARXB=0 D SORRY(2)
;
I $$VCHK("BAR","1.7",2) ; Accounts Receivable V1.7
;
; At least Third Party Billing V2.5 Patch 1 by looking for routine ABMUTLP in routine file
N BARABM
S BARABM=$$VERSION^XPDUTL("ABM")
I BARABM'>2.5 S BARABM=$D(^DIC(9.8,"B","ABMUTLP"))
W !,$$CJ^XLFSTR("Need at least ABM v2.5 Patch 1..... "_$S(BARABM=0:"NOT ",1:"")_" Present",IOM)
I BARABM=0 D SORRY(2)
;
N DA,DIC
S X="BAR"
S DIC="^DIC(9.4,"
S DIC(0)=""
S D="C"
D IX^DIC
I Y<0,$D(^DIC(9.4,"C","BAR")) D
. W !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM)
. W !,$$CJ^XLFSTR("PACKAGE File with an ""BAR"" 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)
D HELP^XBHELP("INTROE","BAREV18")
;
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 HELP^XBHELP("INTROI","BAREV18")
. 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(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 KILL DIFQ S XPDQUIT=BARQUIT D SORRY(BARQUIT) Q 0
Q 1
; ********************************************************************
INSTALLD(BARNM,BARVR,BARPT) ;EP ;RLT
; RLT - 04/05/05 - Per Don Jackson, modified this tag to use
; PATCH^XPDUTL. Removed the reverse $O, problem
; with XU patch numbers. VA (lower than 1000) and
; IHS patch numers (1000 and higher) not loaded
; in numerical order. No longer
; verifies that a lower version did not get
; reinstalled over a higher version.
;INSTALLD(BAR) ;EP ;RLT Old entry point
; Find current version and patch of said application (BAR)
; 1st look up package
;N DIC,X,Y,BARVER,BARVNUM,BARPATCH,BARPNUM
;S X=BAR
;S DIC="^DIC(9.4,"
;S DIC(0)="FM"
;S D="C"
;D IX^DIC
;I Y<1 Q 0
;; 2nd - find current version
;S BARVER=$O(^DIC(9.4,+Y,22,999999),-1) ;last version installed
;I '+BARVER Q 0
;S BARVNUM=$P($G(^DIC(9.4,+Y,22,BARVER,0)),U)
;I '+BARVNUM Q 0
;; 3rd - find last patch installed for current version
;;^DIC(9.4,D0,22,D1,PAH,D2,0)
;S BARPATCH=$O(^DIC(9.4,+Y,22,BARVER,"PAH",999999),-1) ;last patch
;I '+BARPATCH Q 0
;S BARPNUM=$P($G(^DIC(9.4,+Y,22,BARVER,"PAH",BARPATCH,0)),U)
;I '+BARPNUM Q 0
;Q BAR_"*"_BARVNUM_"*"_BARPNUM
;
N BARVNUM,BARPATCH
;1 get current version
S BARVNUM=$$VERSION^XPDUTL(BARNM)
I '+BARVNUM Q 0
;2 is needed patch loaded
S BARPATCH=$$PATCH^XPDUTL(BARNM_"*"_BARVR_"*"_BARPT)
I '+BARPATCH Q 0
Q BARNM_"*"_BARVNUM_"*"_BARPATCH
; ********************************************************************
INTROE ; Intro text during KIDS Environment check.
;;This distribution Modifies Accounts Receivable containing previous patch
;;modifications and:
;;(1) 2 enhanced reports
;;(2) 4 new reports
;;(3) New posting option - Auto Post Beneficiaries
;;(4) 2 EISS enhancements
;;(5) Debt Collections Module
;;###
;;
;
INTROI ; Intro text during KIDS Install.
;;If you run interactively, results will be displayed on your screen,
;;and recorded in the entry in the INSTALL file.
;;If you queue to TaskMan, remember not to Q to the HOME device.
;;###
BAREV18 ; IHS/SD/LSL - ENVIRONMENT CHECK V1.8 ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
+2 ;
+3 ;IHS/SD/RLT - 04/05/05
+4 ; Modified routine to use PATCH^XPDUTL in the INSTALLD tag
+5 ;
+6 IF '$GET(DUZ)
Begin DoDot:1
+7 WRITE !,"DUZ UNDEFINED OR 0."
+8 DO SORRY(2)
End DoDot:1
QUIT
+9 ;
+10 IF '$LENGTH($GET(DUZ(0)))
Begin DoDot:1
+11 WRITE !,"DUZ(0) UNDEFINED OR NULL."
+12 DO SORRY(2)
End DoDot:1
QUIT
+13 ;
+14 ; User's name
SET X=$PIECE(^VA(200,DUZ,0),U)
+15 WRITE !!,$$CJ^XLFSTR("Hello, "_$PIECE(X,",",2)_" "_$PIECE(X,","),IOM)
+16 WRITE !!,$$CJ^XLFSTR("Checking Environment for "_$PIECE($TEXT(+2),";",4)_" V "_$PIECE($TEXT(+2),";",3),IOM)
+17 ;
+18 ;I $$VCHK("XU","8.0",2) ; Kernel V8.0
+19 NEW BARXU
+20 ;S BARXU=$$INSTALLD("XU") ;RLT ; Find current Kernel version and patch
+21 ;RLT ; Find current Kernel version and patch
SET BARXU=$$INSTALLD("XU","8.0",1011)
+22 IF $PIECE(BARXU,"*",2)<8
SET BARXU=0
+23 ;RLT
IF $PIECE(BARXU,"*",3)'=1
SET BARXU=0
+24 ;I $P(BARXU,"*",2)>7,$P(BARXU,"*",2)<9,$P(BARXU,"*",3)<1010 S BARXU=0 ;RLT
+25 WRITE !,$$CJ^XLFSTR("Need at least XU v8.0 Patch 1011..... "_$SELECT(BARXU=0:"NOT ",1:"")_"Present",IOM)
+26 IF BARXU=0
DO SORRY(2)
+27 ;
+28 ; FileMan V21.0
IF $$VCHK("DI","21.0",2)
+29 ;
+30 NEW BARXB
+31 ;S BARXB=$$INSTALLD("XB") ;RLT ; Find current IHS utilities version and patch
+32 ;RLT ; Find current IHS utilities version and patch
SET BARXB=$$INSTALLD("XB","3.0",11)
+33 IF $PIECE(BARXB,"*",2)<3
SET BARXB=0
+34 ;RLT
IF $PIECE(BARXU,"*",3)'=1
SET BARXU=0
+35 ;I $P(BARXB,"*",2)>2,$P(BARXB,"*",2)<4,$P(BARXB,"*",3)<10 S BARXB=0 ;RLT
+36 WRITE !,$$CJ^XLFSTR("Need at least XB v3.0 Patch 11..... "_$SELECT(BARXB=0:"NOT ",1:"")_"Present",IOM)
+37 IF BARXB=0
DO SORRY(2)
+38 ;
+39 ; Accounts Receivable V1.7
IF $$VCHK("BAR","1.7",2)
+40 ;
+41 ; At least Third Party Billing V2.5 Patch 1 by looking for routine ABMUTLP in routine file
+42 NEW BARABM
+43 SET BARABM=$$VERSION^XPDUTL("ABM")
+44 IF BARABM'>2.5
SET BARABM=$DATA(^DIC(9.8,"B","ABMUTLP"))
+45 WRITE !,$$CJ^XLFSTR("Need at least ABM v2.5 Patch 1..... "_$SELECT(BARABM=0:"NOT ",1:"")_" Present",IOM)
+46 IF BARABM=0
DO SORRY(2)
+47 ;
+48 NEW DA,DIC
+49 SET X="BAR"
+50 SET DIC="^DIC(9.4,"
+51 SET DIC(0)=""
+52 SET D="C"
+53 DO IX^DIC
+54 IF Y<0
IF $DATA(^DIC(9.4,"C","BAR"))
Begin DoDot:1
+55 WRITE !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM)
+56 WRITE !,$$CJ^XLFSTR("PACKAGE File with an ""BAR"" prefix.",IOM)
+57 WRITE !,$$CJ^XLFSTR("One entry needs to be deleted.",IOM)
+58 DO SORRY(2)
+59 QUIT
End DoDot:1
+60 ;
+61 IF $GET(XPDQUIT)
WRITE !,$$CJ^XLFSTR("FIX IT! Before Proceeding.",IOM),!!,*7,*7,*7
QUIT
+62 ;
+63 WRITE !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
+64 DO HELP^XBHELP("INTROE","BAREV18")
+65 ;
+66 IF $GET(XPDENV)=1
Begin DoDot:1
+67 ; The following line prevents the "Disable Options..." and "Move
+68 ; Routines..." questions from being asked during the install.
+69 SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+70 DO HELP^XBHELP("INTROI","BAREV18")
+71 QUIT
End DoDot:1
+72 ;
+73 IF '$$DIR^XBDIR("E","","","","","",1)
DO SORRY(2)
+74 QUIT
+75 ; ********************************************************************
SORRY(X) ;
+1 KILL DIFQ
+2 SET XPDQUIT=X
+3 WRITE *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)
+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
KILL DIFQ
SET XPDQUIT=BARQUIT
DO SORRY(BARQUIT)
QUIT 0
+6 QUIT 1
+7 ; ********************************************************************
INSTALLD(BARNM,BARVR,BARPT) ;EP ;RLT
+1 ; RLT - 04/05/05 - Per Don Jackson, modified this tag to use
+2 ; PATCH^XPDUTL. Removed the reverse $O, problem
+3 ; with XU patch numbers. VA (lower than 1000) and
+4 ; IHS patch numers (1000 and higher) not loaded
+5 ; in numerical order. No longer
+6 ; verifies that a lower version did not get
+7 ; reinstalled over a higher version.
+8 ;INSTALLD(BAR) ;EP ;RLT Old entry point
+9 ; Find current version and patch of said application (BAR)
+10 ; 1st look up package
+11 ;N DIC,X,Y,BARVER,BARVNUM,BARPATCH,BARPNUM
+12 ;S X=BAR
+13 ;S DIC="^DIC(9.4,"
+14 ;S DIC(0)="FM"
+15 ;S D="C"
+16 ;D IX^DIC
+17 ;I Y<1 Q 0
+18 ;; 2nd - find current version
+19 ;S BARVER=$O(^DIC(9.4,+Y,22,999999),-1) ;last version installed
+20 ;I '+BARVER Q 0
+21 ;S BARVNUM=$P($G(^DIC(9.4,+Y,22,BARVER,0)),U)
+22 ;I '+BARVNUM Q 0
+23 ;; 3rd - find last patch installed for current version
+24 ;;^DIC(9.4,D0,22,D1,PAH,D2,0)
+25 ;S BARPATCH=$O(^DIC(9.4,+Y,22,BARVER,"PAH",999999),-1) ;last patch
+26 ;I '+BARPATCH Q 0
+27 ;S BARPNUM=$P($G(^DIC(9.4,+Y,22,BARVER,"PAH",BARPATCH,0)),U)
+28 ;I '+BARPNUM Q 0
+29 ;Q BAR_"*"_BARVNUM_"*"_BARPNUM
+30 ;
+31 NEW BARVNUM,BARPATCH
+32 ;1 get current version
+33 SET BARVNUM=$$VERSION^XPDUTL(BARNM)
+34 IF '+BARVNUM
QUIT 0
+35 ;2 is needed patch loaded
+36 SET BARPATCH=$$PATCH^XPDUTL(BARNM_"*"_BARVR_"*"_BARPT)
+37 IF '+BARPATCH
QUIT 0
+38 QUIT BARNM_"*"_BARVNUM_"*"_BARPATCH
+39 ; ********************************************************************
INTROE ; Intro text during KIDS Environment check.
+1 ;;This distribution Modifies Accounts Receivable containing previous patch
+2 ;;modifications and:
+3 ;;(1) 2 enhanced reports
+4 ;;(2) 4 new reports
+5 ;;(3) New posting option - Auto Post Beneficiaries
+6 ;;(4) 2 EISS enhancements
+7 ;;(5) Debt Collections Module
+8 ;;###
+9 ;;
+10 ;
INTROI ; Intro text during KIDS Install.
+1 ;;If you run interactively, results will be displayed on your screen,
+2 ;;and recorded in the entry in the INSTALL file.
+3 ;;If you queue to TaskMan, remember not to Q to the HOME device.
+4 ;;###
