BAREV822 ; IHS/SD/LSL - ENVIRONMENT CHECK V1.8 PATCH 22; 06/01/2010
;;1.8;IHS ACCOUNTS RECEIVABLE;**22**;OCT 26,2005;Build 38
;
K XPDQUIT ;CLEAR FLAG
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)
;
N BARXU
S BARXU=$$INSTALLD("XU","8.0",1011) ;Find current Kernel version and patch
I $P(BARXU,"*",2)<8 S BARXU=0
I $P(BARXU,"*",3)'=1011 S BARXU=0
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","22.0",2) ;FileMan V22.0
;
N BARXB
S BARXB=$$INSTALLD("XB","2.6",11) ;Find current IHS utilities version and patch
I $P(BARXB,"*",2)<3 S BARXB=0
I $P(BARXU,"*",3)'=11 S BARXU=0
;
I $$VCHK("BAR","1.8",2) ;Accounts Receivable V1.8
;3PB 2.6 Patch 4
N BARABM
S BARABM=$$INSTALLD("ABM","2.6",4)
I $P(BARABM,"*",2)<2.6 S BARABM=0
I $P(BARABM,"*",3)<4 S BARABM=0
W !,$$CJ^XLFSTR("Need at least Third Party Billing v2.6 Patch 4..... "_$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
;
;A/R IS NO LONGER CUMULATIVE AFTER PATCH 6
;LAST CUMULATIVE PATCH WAS PATCH 6
N BAR,I
F I=6:1:7,9,10,12,13,14,15,16,17,18,19,20,21 D ;NOTE: BAR*1.8*8 WAS REPLACED WITH BAR*1.8*9
.S BAR=$$INSTALLD("BAR","1.8",I)
.I $P(BAR,"*",3)'=I S BAR=0 D
..W !,$$CJ^XLFSTR("Need Accounts Receivable v1.8 Patch "_I_"..... "_$S(BAR=0:"NOT ",1:"")_"Present",IOM)
I BAR=0 D SORRY(2)
;
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","BAREV810")
;
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","BAREV822")
. Q
;
I '$$DIR^XBDIR("E","","","","","",1) D SORRY(2)
Q
;
POST ;EP - POST INSTALL
Q:$$INSTALLD^BAREV822("BAR","1.8",22)="BAR*1.8*22"
;======================================================================
; SET UP DEBT MANAGEMENT PARAMETERS
; ---------------------------------------------------------------------
F I=1:1:4 S LET(I)=0,LET(I)=$O(^BAR(90052.03,"B","DEBT MANAGEMENT LETTER "_I,LET(I)))
S BARP=0
F S BARP=$O(^BAR(90052.06,BARP)) Q:BARP'?1N.N D
.S BARS=0 F S BARS=$O(^BAR(90052.06,BARP,BARS)) Q:BARS'?1N.N D
..S DIE="^BAR(90052.06,"_BARP_",",DA=BARS
..S DR="1705///"_LET(1)_";1706///"_60_";1707///"_LET(2)_";1708///"_90
..S DR=DR_";1709///"_LET(3)_";1710///"_120_";1711///"_LET(4)_";1712///"_150
..S DR=DR_";1808///250"
..D ^DIE
;
;======================================================================
; ADD DEPT MANAGEMENT Menu
;----------------------------------------------------------------------
I $$ADD^XPDMENU("BAR ACM MAIN","BAR DM MENU","DBT") D MES^XPDUTL($J("",5)_"Debt Management Menu added to the Account Management Menu")
;
D EN^BARADJR7 ;new SARs
D ZNODE ;add zero node for A/R DEBT MANAGEMENT BILLS file bar*1.8*22 SDR
D BMES^XPDUTL("Post-install routine is complete.")
Q
;start new code bar*1.8*22 SDR
ZNODE ;EP
S DUZHOLD=DUZ(2)
S DUZ(2)=0
F S DUZ(2)=$O(^BARBL(DUZ(2))) Q:'+DUZ(2) D
.; A/R Debt Mgmt Bill file
.S BAR("GL")="^BARDM(DUZ(2),0)"
.S @BAR("GL")=^DIC(90053.05,0)
.;A/R Debt Mgmt Print Log file
.S BAR("GL")="^BARDMLG(DUZ(2),0)"
.S @BAR("GL")=^DIC(90053.08,0)
S DUZ(2)=DUZHOLD
K DUZHOLD,BAR
Q
;end new code
;
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
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_"*"_BARPT
;
; ********************************************************************
INTROE ; Intro text during KIDS Environment check.
;;This distribution Modifies Accounts Receivable and does not contain
;;previous patch modifications for version 1.8.
;;
;; This patch is **not** cumulative.
;;
;; Patch contains all menu options, site parameters and letters for
;; the Debt Mangement system.
;; Some parameters have been pre-defined but may be changed under the
;; Debt Management Parameters and Debt Letter Signature/Address parameters
;; options.
;;
;; You also need to set up the insurers/accounts letters will be sent
;; to.
;;
;;###
;;
;
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.
;;###
BAREV822 ; IHS/SD/LSL - ENVIRONMENT CHECK V1.8 PATCH 22; 06/01/2010
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**22**;OCT 26,2005;Build 38
+2 ;
+3 ;CLEAR FLAG
KILL XPDQUIT
+4 IF '$GET(DUZ)
Begin DoDot:1
+5 WRITE !,"DUZ UNDEFINED OR 0"
+6 DO SORRY(2)
End DoDot:1
QUIT
+7 ;
+8 IF '$LENGTH($GET(DUZ(0)))
Begin DoDot:1
+9 WRITE !,"DUZ(0) UNDEFINED OR NULL"
+10 DO SORRY(2)
End DoDot:1
QUIT
+11 ;
+12 ;User's name
SET X=$PIECE(^VA(200,DUZ,0),U)
+13 WRITE !!,$$CJ^XLFSTR("Hello, "_$PIECE(X,",",2)_" "_$PIECE(X,","),IOM)
+14 WRITE !!,$$CJ^XLFSTR("Checking Environment for "_$PIECE($TEXT(+2),";",4)_" V "_$PIECE($TEXT(+2),";",3),IOM)
+15 ;
+16 NEW BARXU
+17 ;Find current Kernel version and patch
SET BARXU=$$INSTALLD("XU","8.0",1011)
+18 IF $PIECE(BARXU,"*",2)<8
SET BARXU=0
+19 IF $PIECE(BARXU,"*",3)'=1011
SET BARXU=0
+20 WRITE !,$$CJ^XLFSTR("Need at least XU v8.0 Patch 1011..... "_$SELECT(BARXU=0:"NOT ",1:"")_"Present",IOM)
+21 IF BARXU=0
DO SORRY(2)
+22 ;
+23 ;FileMan V22.0
IF $$VCHK("DI","22.0",2)
+24 ;
+25 NEW BARXB
+26 ;Find current IHS utilities version and patch
SET BARXB=$$INSTALLD("XB","2.6",11)
+27 IF $PIECE(BARXB,"*",2)<3
SET BARXB=0
+28 IF $PIECE(BARXU,"*",3)'=11
SET BARXU=0
+29 ;
+30 ;Accounts Receivable V1.8
IF $$VCHK("BAR","1.8",2)
+31 ;3PB 2.6 Patch 4
+32 NEW BARABM
+33 SET BARABM=$$INSTALLD("ABM","2.6",4)
+34 IF $PIECE(BARABM,"*",2)<2.6
SET BARABM=0
+35 IF $PIECE(BARABM,"*",3)<4
SET BARABM=0
+36 WRITE !,$$CJ^XLFSTR("Need at least Third Party Billing v2.6 Patch 4..... "_$SELECT(BARABM=0:"NOT ",1:"")_"Present",IOM)
+37 IF BARABM=0
DO SORRY(2)
+38 ;
+39 NEW DA,DIC
+40 SET X="BAR"
+41 SET DIC="^DIC(9.4,"
+42 SET DIC(0)=""
+43 SET D="C"
+44 DO IX^DIC
+45 IF Y<0
IF $DATA(^DIC(9.4,"C","BAR"))
Begin DoDot:1
+46 WRITE !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM)
+47 WRITE !,$$CJ^XLFSTR("PACKAGE File with an ""BAR"" prefix.",IOM)
+48 WRITE !,$$CJ^XLFSTR("One entry needs to be deleted.",IOM)
+49 DO SORRY(2)
+50 QUIT
End DoDot:1
+51 ;
+52 ;A/R IS NO LONGER CUMULATIVE AFTER PATCH 6
+53 ;LAST CUMULATIVE PATCH WAS PATCH 6
+54 NEW BAR,I
+55 ;NOTE: BAR*1.8*8 WAS REPLACED WITH BAR*1.8*9
FOR I=6:1:7,9,10,12,13,14,15,16,17,18,19,20,21
Begin DoDot:1
+56 SET BAR=$$INSTALLD("BAR","1.8",I)
+57 IF $PIECE(BAR,"*",3)'=I
SET BAR=0
Begin DoDot:2
+58 WRITE !,$$CJ^XLFSTR("Need Accounts Receivable v1.8 Patch "_I_"..... "_$SELECT(BAR=0:"NOT ",1:"")_"Present",IOM)
End DoDot:2
End DoDot:1
+59 IF BAR=0
DO SORRY(2)
+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","BAREV810")
+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","BAREV822")
+71 QUIT
End DoDot:1
+72 ;
+73 IF '$$DIR^XBDIR("E","","","","","",1)
DO SORRY(2)
+74 QUIT
+75 ;
POST ;EP - POST INSTALL
+1 IF $$INSTALLD^BAREV822("BAR","1.8",22)="BAR*1.8*22"
QUIT
+2 ;======================================================================
+3 ; SET UP DEBT MANAGEMENT PARAMETERS
+4 ; ---------------------------------------------------------------------
+5 FOR I=1:1:4
SET LET(I)=0
SET LET(I)=$ORDER(^BAR(90052.03,"B","DEBT MANAGEMENT LETTER "_I,LET(I)))
+6 SET BARP=0
+7 FOR
SET BARP=$ORDER(^BAR(90052.06,BARP))
IF BARP'?1N.N
QUIT
Begin DoDot:1
+8 SET BARS=0
FOR
SET BARS=$ORDER(^BAR(90052.06,BARP,BARS))
IF BARS'?1N.N
QUIT
Begin DoDot:2
+9 SET DIE="^BAR(90052.06,"_BARP_","
SET DA=BARS
+10 SET DR="1705///"_LET(1)_";1706///"_60_";1707///"_LET(2)_";1708///"_90
+11 SET DR=DR_";1709///"_LET(3)_";1710///"_120_";1711///"_LET(4)_";1712///"_150
+12 SET DR=DR_";1808///250"
+13 DO ^DIE
End DoDot:2
End DoDot:1
+14 ;
+15 ;======================================================================
+16 ; ADD DEPT MANAGEMENT Menu
+17 ;----------------------------------------------------------------------
+18 IF $$ADD^XPDMENU("BAR ACM MAIN","BAR DM MENU","DBT")
DO MES^XPDUTL($JUSTIFY("",5)_"Debt Management Menu added to the Account Management Menu")
+19 ;
+20 ;new SARs
DO EN^BARADJR7
+21 ;add zero node for A/R DEBT MANAGEMENT BILLS file bar*1.8*22 SDR
DO ZNODE
+22 DO BMES^XPDUTL("Post-install routine is complete.")
+23 QUIT
+24 ;start new code bar*1.8*22 SDR
ZNODE ;EP
+1 SET DUZHOLD=DUZ(2)
+2 SET DUZ(2)=0
+3 FOR
SET DUZ(2)=$ORDER(^BARBL(DUZ(2)))
IF '+DUZ(2)
QUIT
Begin DoDot:1
+4 ; A/R Debt Mgmt Bill file
+5 SET BAR("GL")="^BARDM(DUZ(2),0)"
+6 SET @BAR("GL")=^DIC(90053.05,0)
+7 ;A/R Debt Mgmt Print Log file
+8 SET BAR("GL")="^BARDMLG(DUZ(2),0)"
+9 SET @BAR("GL")=^DIC(90053.08,0)
End DoDot:1
+10 SET DUZ(2)=DUZHOLD
+11 KILL DUZHOLD,BAR
+12 QUIT
+13 ;end new code
+14 ;
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 NEW BARVNUM,BARPATCH
+2 ;1 get current version
+3 SET BARVNUM=$$VERSION^XPDUTL(BARNM)
+4 IF '+BARVNUM
QUIT 0
+5 ;2 is needed patch loaded
+6 SET BARPATCH=$$PATCH^XPDUTL(BARNM_"*"_BARVR_"*"_BARPT)
+7 IF '+BARPATCH
QUIT 0
+8 QUIT BARNM_"*"_BARVNUM_"*"_BARPT
+9 ;
+10 ; ********************************************************************
INTROE ; Intro text during KIDS Environment check.
+1 ;;This distribution Modifies Accounts Receivable and does not contain
+2 ;;previous patch modifications for version 1.8.
+3 ;;
+4 ;; This patch is **not** cumulative.
+5 ;;
+6 ;; Patch contains all menu options, site parameters and letters for
+7 ;; the Debt Mangement system.
+8 ;; Some parameters have been pre-defined but may be changed under the
+9 ;; Debt Management Parameters and Debt Letter Signature/Address parameters
+10 ;; options.
+11 ;;
+12 ;; You also need to set up the insurers/accounts letters will be sent
+13 ;; to.
+14 ;;
+15 ;;###
+16 ;;
+17 ;
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 ;;###
