BAREV174.m

BAREV174 ; IHS/SD/LSL - ENVIRONMENT CHECK V1.7 Patch 4 ; 

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

 ;

 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)_" Patch "_$P($T(+2),"**",2),IOM)

 ;

 I $$VCHK("XU","8.0",2)              ; Kernel V8.0

 I $$VCHK("DI","21.0",2)             ; FileMan V21.0

 I $$VCHK("BAR","1.7",2)             ; Accounts Receivable V1.7

 ;

 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","BAREV174")

 ;

 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","BAREV174")

 . 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

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

INTROE ; Intro text during KIDS Environment check.

 ;;This distribution updates Accounts Receivable V1.7 with Patch 4 modifications.

 ;;This patch will accomodate HIPAA 835 Electronic Remittance Advice processing

 ;;using the existing ERA menu options, update the Standard Claim Level

 ;;Adjustment Reason Codes, allow the Patient Account Statement to execute

 ;;correctly at multifacility sites, modify the ASM to sort by Visit Location to

 ;;better accomodate EISS, and resolves 4 Support Center Calls.

 ;;###

 ;;

 ;

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.

 ;;###

BAREV174  ; IHS/SD/LSL - ENVIRONMENT CHECK V1.7 Patch 4 ; 

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

 +2       ;

 +3        IF '$GET(DUZ)

               Begin DoDot:1

 +4                WRITE !,"DUZ UNDEFINED OR 0."

 +5                DO SORRY(2)

               End DoDot:1

               QUIT 

 +6       ;

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

               Begin DoDot:1

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

 +9                DO SORRY(2)

               End DoDot:1

               QUIT 

 +10      ;

 +11      ; User's name

           SET X=$PIECE(^VA(200,DUZ,0),U)

 +12       WRITE !!,$$CJ^XLFSTR("Hello, "_$PIECE(X,",",2)_" "_$PIECE(X,","),IOM)

 +13       WRITE !!,$$CJ^XLFSTR("Checking Environment for "_$PIECE($TEXT(+2),";",4)_" V "_$PIECE($TEXT(+2),";",3)_" Patch "_$PIECE($TEXT(+2),"**",2),IOM)

 +14      ;

 +15      ; Kernel V8.0

           IF $$VCHK("XU","8.0",2)

 +16      ; FileMan V21.0

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

 +17      ; Accounts Receivable V1.7

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

 +18      ;

 +19       NEW DA,DIC

 +20       SET X="BAR"

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

 +22       SET DIC(0)=""

 +23       SET D="C"

 +24       DO IX^DIC

 +25       IF Y<0

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

                   Begin DoDot:1

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

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

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

 +29                   DO SORRY(2)

 +30                   QUIT 

                   End DoDot:1

 +31      ;

 +32       IF $GET(XPDQUIT)

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

               QUIT 

 +33      ;

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

 +35       DO HELP^XBHELP("INTROE","BAREV174")

 +36      ;

 +37       IF $GET(XPDENV)=1

               Begin DoDot:1

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

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

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

 +41               DO HELP^XBHELP("INTROI","BAREV174")

 +42               QUIT 

               End DoDot:1

 +43      ;

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

               DO SORRY(2)

 +45       QUIT 

 +46      ; ********************************************************************

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

INTROE    ; Intro text during KIDS Environment check.

 +1       ;;This distribution updates Accounts Receivable V1.7 with Patch 4 modifications.

 +2       ;;This patch will accomodate HIPAA 835 Electronic Remittance Advice processing

 +3       ;;using the existing ERA menu options, update the Standard Claim Level

 +4       ;;Adjustment Reason Codes, allow the Patient Account Statement to execute

 +5       ;;correctly at multifacility sites, modify the ASM to sort by Visit Location to

 +6       ;;better accomodate EISS, and resolves 4 Support Center Calls.

 +7       ;;###

 +8       ;;

 +9       ;

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