Routine: BAREV819

BAREV819 ; IHS/SD/LSL - ENVIRONMENT CHECK V1.8 PATCH 819; 06/01/2010

 ;;1.8;IHS ACCOUNTS RECEIVABLE;**19**;OCT 26,2005

 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","21.0",2)                 ;FileMan V21.0

 I $$VCHK("DI","22.0",2)                 ;FileMan V22.0  1.8*19

 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

 ; commented out - removed from notes file 1.8*19

 ;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.8",2)                 ;Accounts Receivable V1.8

3PB 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 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","BAREV810")

. Q

 I '$$DIR^XBDIR("E","","","","","",1) D SORRY(2)

POST ;EP - POST INSTALL

 ;======================================================================

 ; Rebuild all cross-references for A/R EDI STND CLAIMS ADJ REASONS file

 ; ---------------------------------------------------------------------

 S DIK="^BARADJ("

 D IXALL^DIK

 ;======================================================================

 ; A/R Menu updates:

 ;----------------------------------------------------------------------

 I '$G(DUZ) W !,"DUZ UNDEFINED OR 0." Q

 I '$L($G(DUZ(0))) W !,"DUZ(0) UNDEFINED OR NULL." Q

 I '(DUZ(0)["@") W:'$D(ZTQUEUED) !,"DUZ(0) DOES NOT CONTAIN AN '@'." Q

 ; REMOVED $$ADD^XPDMENU code and included Menues in the KIDS build 1/10/11 1.8*19

 D BMES^XPDUTL("Post-install routine is complete.")

POSTPPAY ;  initial set of A/R Prepayment files

 ;======================================================================

 ; Setup ^BARPPAY for all DUZ(2) defined in A/R Collection Batch file:

 ;----------------------------------------------------------------------

 W !!,"Initialize A/R PREPAYMENT files",!!

 S BARDUZ2=0 F  S BARDUZ2=$O(^BAR(90052.06,BARDUZ2)) Q:'BARDUZ2  D

 . I '$D(^BARPPAY(BARDUZ2)) S ^BARPPAY(BARDUZ2,0)="A/R PREPAYMENT^90050.06^^"

 . W !,"  ",$$GET1^DIQ(4,BARDUZ2_",",.01,"E")

 W !!,"A/R PREPAYMENT file setup complete",!!

 ;======================================================================

 ; Set file security for new A/R Prepayment file (^BARPPAY)

 ;----------------------------------------------------------------------

 F BARNODE="DEL","LAYGO","AUDIT","DD" S ^DIC(90050.06,0,BARNODE)="@"

 F BARNODE="RD","WR" S ^DIC(90050.06,0,BARNODE)="V"

 ;======================================================================

 ;----------------------------------------------------------------------

ENTRY ;

 ; Create entry

 S BARD=";;"

 F BARIEN=25 D EN

 D ^BARVKL0

 D ENTRY2

 ; *********************************************************************

EN ;

 S BARVALUE=$P($T(@BARIEN),BARD,2,3)

 K DIC,DA,X,Y

 S DIC="^BAR(90052.01,"

 S DIC(0)="LZE"

 S DINUM=BARIEN

 S DLAYGO=90052.01

 S X=$P(BARVALUE,BARD)

 S DIC("DR")="2///^S X=$P(BARVALUE,BARD,2)"

 K DD,DO

 D FILE^DICN

 ; *********************************************************************

 ; NAME;;ACRONYM

 ; *********************************************************************

25 ;;SENT TO COLLECTIONS;;STC

ENTRY2 ;

 ; Create entry

 S BARD=";;"

 S BARCNT=0

 F  D EN2 Q:BARVALUE="END"

 D ^BARVKL0

 ; ********************************************************************

EN2 ;

 S BARCNT=BARCNT+1

 S BARVALUE=$P($T(@1+BARCNT),BARD,2,5)

 Q:BARVALUE="END"

 K DIC,DA,X,Y

 S DIC="^BARTBL("

 S DIC(0)="LZE"

 S DINUM=$P(BARVALUE,BARD)

 S DLAYGO=90052.02

 S X=$P(BARVALUE,BARD,2)

 S DIC("DR")="2///^S X=$P(BARVALUE,BARD,3)"

 S DIC("DR")=DIC("DR")_";6////"_$P(BARVALUE,BARD,4)

 K DD,DO

 D FILE^DICN

 ; *********************************************************************

 ; IEN;;NAME;;TABLE TYPE;;ACRONYM

 ; *********************************************************************

1 ;;

 ;;990;;PSC (PROGRAM SUPPORT CENTER);;25;;PSC

 ;;991;;LOCAL COLLECTION COMPANY;;25;;COL

 ;;992;;INTERNAL COLLECTIONS;;25;;ICOL

 ;;993;;STATUS CHANGE;;7;;STC

 ;;END

SORRY(X) ;

 KILL DIFQ

 S XPDQUIT=X

 W *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)

 ; ***

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.

 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.

;;

 ;;###

;;

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.

 ;;###

BAREV819  ; IHS/SD/LSL - ENVIRONMENT CHECK V1.8 PATCH 819; 06/01/2010

 +1       ;;1.8;IHS ACCOUNTS RECEIVABLE;**19**;OCT 26,2005

 +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      ;I $$VCHK("DI","21.0",2)                 ;FileMan V21.0

 +24      ;FileMan V22.0  1.8*19

           IF $$VCHK("DI","22.0",2)

 +25      ;

 +26       NEW BARXB

 +27      ;Find current IHS utilities version and patch

           SET BARXB=$$INSTALLD("XB","2.6",11)

 +28       IF $PIECE(BARXB,"*",2)<3

               SET BARXB=0

 +29       IF $PIECE(BARXU,"*",3)'=11

               SET BARXU=0

 +30      ; commented out - removed from notes file 1.8*19

 +31      ;W !,$$CJ^XLFSTR("Need at least XB v3.0 Patch 11..... "_$S(BARXB=0:"NOT ",1:"")_"Present",IOM)

 +32      ;I BARXB=0 D SORRY(2)

 +33      ;

 +34      ;Accounts Receivable V1.8

           IF $$VCHK("BAR","1.8",2)

 +35      ;

3PB        NEW BARABM

 +1        SET BARABM=$$INSTALLD("ABM","2.6",4)

 +2        IF $PIECE(BARABM,"*",2)<2.6

               SET BARABM=0

 +3        IF $PIECE(BARABM,"*",3)<4

               SET BARABM=0

 +4        WRITE !,$$CJ^XLFSTR("Need at least Third Party Billing v2.6 Patch 4..... "_$SELECT(BARABM=0:"NOT ",1:"")_"Present",IOM)

 +5        IF BARABM=0

               DO SORRY(2)

 +6       ;

 +7        NEW DA,DIC

 +8        SET X="BAR"

 +9        SET DIC="^DIC(9.4,"

 +10       SET DIC(0)=""

 +11       SET D="C"

 +12       DO IX^DIC

 +13       IF Y<0

               IF $DATA(^DIC(9.4,"C","BAR"))

                   Begin DoDot:1

 +14                   WRITE !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM)

 +15                   WRITE !,$$CJ^XLFSTR("PACKAGE File with an ""BAR"" prefix.",IOM)

 +16                   WRITE !,$$CJ^XLFSTR("One entry needs to be deleted.",IOM)

 +17                   DO SORRY(2)

 +18                   QUIT

                   End DoDot:1

 +19      ;

 +20      ;A/R IS NO LONGER CUMULATIVE AFTER PATCH 6

 +21      ;LAST CUMULATIVE PATCH WAS PATCH 6

 +22       NEW BAR,I

 +23      ;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

               Begin DoDot:1

 +24               SET BAR=$$INSTALLD("BAR","1.8",I)

 +25               IF $PIECE(BAR,"*",3)'=I

                       SET BAR=0

                       Begin DoDot:2

 +26                       WRITE !,$$CJ^XLFSTR("Need Accounts Receivable v1.8 Patch "_I_"..... "_$SELECT(BAR=0:"NOT ",1:"")_"Present",IOM)

                       End DoDot:2

               End DoDot:1

 +27       IF BAR=0

               DO SORRY(2)

 +28      ;

 +29       IF $GET(XPDQUIT)

               WRITE !,$$CJ^XLFSTR("FIX IT! Before Proceeding.",IOM),!!,*7,*7,*7

               QUIT

 +30      ;

 +31       WRITE !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)

 +32       DO HELP^XBHELP("INTROE","BAREV810")

 +33      ;

 +34       IF $GET(XPDENV)=1

               Begin DoDot:1

 +35      ; The following line prevents the "Disable Options..." and "Move

 +36      ; Routines..." questions from being asked during the install.

 +37               SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0

 +38               DO HELP^XBHELP("INTROI","BAREV810")

 +39               QUIT

               End DoDot:1

 +40      ;

 +41       IF '$$DIR^XBDIR("E","","","","","",1)

               DO SORRY(2)

 +42       QUIT

 +43      ;

POST      ;EP - POST INSTALL

 +1       ;======================================================================

 +2       ; Rebuild all cross-references for A/R EDI STND CLAIMS ADJ REASONS file

 +3       ; ---------------------------------------------------------------------

 +4        SET DIK="^BARADJ("

 +5        DO IXALL^DIK

 +6       ;

 +7       ;======================================================================

 +8       ; A/R Menu updates:

 +9       ;----------------------------------------------------------------------

 +10       IF '$GET(DUZ)

               WRITE !,"DUZ UNDEFINED OR 0."

               QUIT

 +11      ;

 +12       IF '$LENGTH($GET(DUZ(0)))

               WRITE !,"DUZ(0) UNDEFINED OR NULL."

               QUIT

 +13      ;

 +14       IF '(DUZ(0)["@")

               IF '$DATA(ZTQUEUED)

                   WRITE !,"DUZ(0) DOES NOT CONTAIN AN '@'."

               QUIT

 +15      ;

 +16      ; REMOVED $$ADD^XPDMENU code and included Menues in the KIDS build 1/10/11 1.8*19

 +17       DO BMES^XPDUTL("Post-install routine is complete.")

 +18      ;

POSTPPAY  ;  initial set of A/R Prepayment files

 +1       ;======================================================================

 +2       ; Setup ^BARPPAY for all DUZ(2) defined in A/R Collection Batch file:

 +3       ;----------------------------------------------------------------------

 +4        WRITE !!,"Initialize A/R PREPAYMENT files",!!

 +5        SET BARDUZ2=0

FOR

               SET BARDUZ2=$ORDER(^BAR(90052.06,BARDUZ2))

               IF 'BARDUZ2

                   QUIT

               Begin DoDot:1

 +6                IF '$DATA(^BARPPAY(BARDUZ2))

                       SET ^BARPPAY(BARDUZ2,0)="A/R PREPAYMENT^90050.06^^"

 +7                WRITE !,"  ",$$GET1^DIQ(4,BARDUZ2_",",.01,"E")

               End DoDot:1

 +8        WRITE !!,"A/R PREPAYMENT file setup complete",!!

 +9       ;

 +10      ;======================================================================

 +11      ; Set file security for new A/R Prepayment file (^BARPPAY)

 +12      ;----------------------------------------------------------------------

 +13       FOR BARNODE="DEL","LAYGO","AUDIT","DD"

               SET ^DIC(90050.06,0,BARNODE)="@"

 +14       FOR BARNODE="RD","WR"

               SET ^DIC(90050.06,0,BARNODE)="V"

 +15      ;

 +16      ;======================================================================

 +17      ;

 +18      ;----------------------------------------------------------------------

 +19      ;

 +20      ;

ENTRY     ;

 +1       ; Create entry

 +2        SET BARD=";;"

 +3        FOR BARIEN=25

               DO EN

 +4        DO ^BARVKL0

 +5        DO ENTRY2

 +6        QUIT

 +7       ; *********************************************************************

 +8       ;

EN        ;

 +1        SET BARVALUE=$PIECE($TEXT(@BARIEN),BARD,2,3)

 +2        KILL DIC,DA,X,Y

 +3        SET DIC="^BAR(90052.01,"

 +4        SET DIC(0)="LZE"

 +5        SET DINUM=BARIEN

 +6        SET DLAYGO=90052.01

 +7        SET X=$PIECE(BARVALUE,BARD)

 +8        SET DIC("DR")="2///^S X=$P(BARVALUE,BARD,2)"

 +9        KILL DD,DO

 +10       DO FILE^DICN

 +11       QUIT

 +12      ; *********************************************************************

 +13      ; NAME;;ACRONYM

 +14      ; *********************************************************************

25        ;;SENT TO COLLECTIONS;;STC

 +1       ;

ENTRY2    ;

 +1       ; Create entry

 +2        SET BARD=";;"

 +3        SET BARCNT=0

 +4        FOR

               DO EN2

               IF BARVALUE="END"

                   QUIT

 +5        DO ^BARVKL0

 +6        QUIT

 +7       ; ********************************************************************

EN2       ;

 +1        SET BARCNT=BARCNT+1

 +2        SET BARVALUE=$PIECE($TEXT(@1+BARCNT),BARD,2,5)

 +3        IF BARVALUE="END"

               QUIT

 +4        KILL DIC,DA,X,Y

 +5        SET DIC="^BARTBL("

 +6        SET DIC(0)="LZE"

 +7        SET DINUM=$PIECE(BARVALUE,BARD)

 +8        SET DLAYGO=90052.02

 +9        SET X=$PIECE(BARVALUE,BARD,2)

 +10       SET DIC("DR")="2///^S X=$P(BARVALUE,BARD,3)"

 +11       SET DIC("DR")=DIC("DR")_";6////"_$PIECE(BARVALUE,BARD,4)

 +12       KILL DD,DO

 +13       DO FILE^DICN

 +14       QUIT

 +15      ; *********************************************************************

 +16      ; IEN;;NAME;;TABLE TYPE;;ACRONYM

 +17      ; *********************************************************************

1         ;;

 +1       ;;990;;PSC (PROGRAM SUPPORT CENTER);;25;;PSC

 +2       ;;991;;LOCAL COLLECTION COMPANY;;25;;COL

 +3       ;;992;;INTERNAL COLLECTIONS;;25;;ICOL

 +4       ;;993;;STATUS CHANGE;;7;;STC

 +5       ;;END

 +6       ;

 +7       ;

 +8       ;

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        NEW BARVNUM,BARPATCH

 +9       ;1 get current version

 +10       SET BARVNUM=$$VERSION^XPDUTL(BARNM)

 +11       IF '+BARVNUM

               QUIT 0

 +12      ;2 is needed patch loaded

 +13       SET BARPATCH=$$PATCH^XPDUTL(BARNM_"*"_BARVR_"*"_BARPT)

 +14       IF '+BARPATCH

               QUIT 0

 +15       QUIT BARNM_"*"_BARVNUM_"*"_BARPT

 +16      ;

 +17      ; ********************************************************************

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       ;;###

 +7       ;;

 +8       ;

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       ;;###

BAREV819.m