Routine: BAREV185

BAREV185 ; IHS/SD/LSL - ENVIRONMENT CHECK V1.8 PATCH 5; 05/08/2008

 ;;1.8;IHS ACCOUNTS RECEIVABLE;**1,2,3,4,5**;APR 27,2007

 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)

 ;BAR*1.8*4 -- ONLY

 ;ALL SESSIONS MUST BE TRANSPORTED BEFORE INSTALL OF PATCH 4

 I $P($$INSTALLD("BAR","1.8",4),"*",3)'=1 D

 .S BAROK=1

 .D ADDDIS          ;ADD DEFAULT (#1504) UFMS DISPLAY DATE LIMIT

 .D TASK(DUZ(2),.BAROK)

 .I 'BAROK D  Q

 .. W !!,*7,*7

 .. W $$CJ^XLFSTR("There are sessions that have not been transmitted",IOM)

 .. W !,$$CJ^XLFSTR("Please give the A/R cashiers the above list",IOM)

 .. W !,$$CJ^XLFSTR("Cannot proceed until all sessions are transmitted",IOM)

 .. 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)     ;RLT     ; Find current Kernel version and patch

 I $P(BARXU,"*",2)<8 S BARXU=0

 I $P(BARXU,"*",3)'=1 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","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

 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

 N BARABM

 S BARABM=$$INSTALLD("ABM","2.5",13)

 I $P(BARABM,"*",2)<2.5 S BARABM=0

 I $P(BARABM,"*",3)'=1 S BARABM=0

 W !,$$CJ^XLFSTR("Need at least Third Party Billing v2.5 Patch 13..... "_$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

 ;LETS DOUBLE CHECK - MAKE SURE THEY SAVE THE GLOBALS OFF

 ;DONE IF UPDATING A/R TABLES

 ;I '$G(XPDQUIT) D

 ;.W !!!,$$CJ^XLFSTR("IMPORTANT: PLEASE MAKE SURE YOU SAVE THE FOLLOWING GLOBALS TO DISK?",IOM)

 ;.W !,$$CJ^XLFSTR("USE ^%GOGEN TO SAVE ^BAR(90052.01",IOM)

 ;.W !,$$CJ^XLFSTR("USE ^%GO TO SAVE ^BARTBL",IOM)

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

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

. Q

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

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

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_"*"_BARPATCH

POST ;EP - POST INSTALL OF ZISH ENTRIES AND QUEING OF BIZTALK TASK

 D STUFFDCM       ;Stuff too long target id into

 D FIXADJ3        ;FIX A/R EDI STND CLAIM ADJ REASONS STANDARD ADJUSTMENT CODE 3

 ;                BAD ENTRY IN FIELD .03 (14;17) IM21683,IM23712

 D AWODT          ;CHANGE THE AWO EXPIRATION DATE

 D ADWO            ;ADD NEW WRITE OFF ENTRY IN BARTBL AT 916 SO IT DOESNOT GET OVERWRITTEN BY

 ;                  NEW ENTRIES IN PATCH 2

 D EDIHIPAA       ;EDIT "HIPAA 835 v4010" ENTRY IN A/R EDI TRANSPORT FILE

 ;set default value for field #22 in A/R COLLECTION POINT file

 D COLPOINT

 D ADDZISH         ;ADD ZISH SEND PARAMETER ENTRIES FOR UFMS

TASK(SAFEDUZ2,BAROK) ;EP - FOR PATCH 4 ONLY

 K ^BARBOB("BARZ")

CKSESS ;

 ; Session status can be:   O    OPEN

 ;                          RC   RECONCILED

 ;                          RV   REVIEWED/APPROVED

 ;                          T    TRANSMITTED

 ;                          RT   RETRANSMITTED

 K BAR

 N BARLOC,BARST,BARUDUZ,BAR

 S DUZ(2)=0

 F  S DUZ(2)=$O(^BARSESS(DUZ(2))) Q:'DUZ(2)  D

 .K ^BARSESS(DUZ(2),"NS")              ;CLEAN OUT NOT SENT BUCKET

 .Q:'$$IHS^BARUFUT(DUZ(2))

 .S BARLOC=$P(^AUTTLOC(DUZ(2),0),U,2)

 .S BARST=0

 .F  S BARST=$O(^BARSESS(DUZ(2),"C",BARST)) Q:BARST=""  D

 ..Q:BARST["TRANSMIT"            ;DON'T WANT (RE)TRANSMITTED

 ..S BARUDUZ=0

 ..F  S BARUDUZ=$O(^BARSESS(DUZ(2),"C",BARST,BARUDUZ)) Q:'BARUDUZ  D

 ...D LOOP(BARUDUZ,BARST)

 I '$D(BAR) Q

 D WRT

 S BAROK=0

 S DUZ(2)=SAFEDUZ2

LOOP(UDUZ,STAT) ; - GET DATA FROM SESSION LEVEL

 N SESSID,ERASTAT,CURSTAT,STATDATE,POSTING

 S CASHIER=$E($P($G(^VA(200,UDUZ,0)),U),1,17)

 S SESSID=0

 F  S SESSID=$O(^BARSESS(DUZ(2),"C",STAT,UDUZ,SESSID)) Q:SESSID=""  D

 .S IENS=SESSID_","_UDUZ_","

 .S SESSDT=$$GET1^DIQ(90057.11,IENS,.01,"I")

 .I SESSDT<3071001 Q              ;IGNORE PRE-UFMS SESSIONS

 .S CURSTAT=$$GET1^DIQ(90057.11,IENS,.02,"E")

 .S STATDATE=$$GET1^DIQ(90057.11,IENS,.03,"E")

 .S ERASTAT=$E($$GET1^DIQ(90057.11,IENS,.04,"E"))

 .S POSTING=$$STILPOST^BARUFUT1(UDUZ)

 .S Y=STATDATE X ^DD("DD") S STATDATE=Y

 .S BAR(CASHIER,BARLOC,STAT,SESSID)=""

WRT ;

 W !!?25,"OPEN SESSIONS LIST FOR: "

 W !,"CASHIER",?22,"LOCATION",?45,"STATUS",?65,"SESSION ID",!

 N A,B,C,D

 S A=""

 F  S A=$O(BAR(A)) Q:A=""  D              ;CASHIER

 .S B=0

 .F  S B=$O(BAR(A,B)) Q:B=""  D           ;DUZ(2)

 ..S C=0

 ..F  S C=$O(BAR(A,B,C)) Q:C=""  D        ;STATUS

 ...S D=0

 ...W A,?19,$E(B,1,20),?40,$E(C,1,20)

 ...F  S D=$O(BAR(A,B,C,D)) Q:'D  D       ;SESSION ID

 ....W ?62,D,!

ADDDIS ;EP -

 K DIE,DR,DIC,DIE,DIR,DA

 ;S DR="1504////^S X=""T-1W"";1505////30"""

 S X1=3071001

 S X2=DT

 D ^%DTC

 S BARDT=X

 S DUZ2=1

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

 .S DA(1)=DUZ2

 .S DA=0

 .F  S DA=$O(^BAR(90052.06,DUZ2,DA)) Q:'DA  D

 ..S DR="1504////T"_BARDT

 ..S DR=DR_";1505////30"""  ;IHS/SD/TPF BAR*1.8*4 IM26189

 ..I '$$IHS^BARUFUT(DA) S DR=DR_";1502////1;1503////1"  ;FOR NON-IHS SITES

 ..S DIE="^BAR(90052.06,"_DA(1)_","

 ..D ^DIE

COLPOINT ;EP -

 K DIE,DR,DIC,DIE,DIR,DA

 S DR="22////^S X=1"

 S DUZ2=1

 N BART                                          ;BAR*1.8*4

 F  S DUZ2=$O(^BAR(90051.02,DUZ2)) Q:'DUZ2  D

 .S DA(1)=DUZ2

 .S DA=0

 .F  S DA=$O(^BAR(90051.02,DUZ2,DA)) Q:'DA  D

 ..S BART=$P($G(^BAR(90051.02,DUZ2,DA,0)),U,22)  ;BAR*1.8*4

 ..Q:BART'=""                  ;DON'T OVERWRITE  ;BAR*1.8*4

 ..S DIE="^BAR(90051.02,"_DA(1)_","

 ..D ^DIE

ADWO ; EP

 N ADWO

 S ADWO="^BARTBL(916,0)"

 S @ADWO="AUTO WRITE-OFF 2007^3^WO"

 S DIK="^BARTBL(" D IXALL^DIK

AWODT ;EP -

 K DIR,DIE,DIC,DA,DR

 S DR="15////^S X=3070525"

 S DUZ2=1

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

 .S DIE="^BAR(90052.06,"_DUZ2_","

 .S DA=DUZ2

 .D ^DIE

EDIHIPAA ;EP - EDIT HIPAA TRANSPORT ENTRY

 N TRANIEN

 S TRANIEN=$O(^BAREDI("1T","B","HIPAA 835 v4010",""))

 I 'TRANIEN D  Q

 .W !,$$CJ^XLFSTR("CANNOT FIND HIPAA 835 v4010 ENTRY!!",IOM)

 .W !,$$CJ^XLFSTR("INFORM THE HELP DESK IMMEDIATELY!!",IOM)

 ;BEGIN UPDATING FIELDS

 ;EDIT SEGMENT 2-080.B-N1

 ;IDENTIFICATION CODE QUALIFIER

 K DIE,DIC,DA,DR,DIR

 S DA(2)=TRANIEN

 S DA(1)=15

 S DA=3

 S DIE="^BAREDI(""1T"","_DA(2)_",10,"_DA(1)_",10,"

 S BARVAL="VICQ"

 S DR=".08///^S X=BARVAL"

 D ^DIE

 ;IDENTIFICATION CODE

 K DIE,DIC,DA,DR,DIR

 S DA(2)=TRANIEN

 S DA(1)=15

 S DA=4

 S DIE="^BAREDI(""1T"","_DA(2)_",10,"_DA(1)_",10,"

 S BARVAL="VIC"

 S DR=".08///^S X=BARVAL"

 D ^DIE

 ;REFERENCE ID QUALIFIER

 K DIE,DIC,DA,DR,DIR

 S DA(2)=TRANIEN

 S DA(1)=18

 S DA=1

 S DIE="^BAREDI(""1T"","_DA(2)_",10,"_DA(1)_",10,"

 S BARVAL="VREFBIQ"

 S DR=".08///^S X=BARVAL"

 D ^DIE

 ;REFERENCE IDENTIFICATION

 K DIE,DIC,DA,DR,DIR

 S DA(2)=TRANIEN

 S DA(1)=18

 S DA=2

 S DIE="^BAREDI(""1T"","_DA(2)_",10,"_DA(1)_",10,"

 S BARVAL="VREFBID"

 S DR=".08///^S X=BARVAL"

 D ^DIE

 ;VARIABLE PROCESSING

 K DIE,DIC,DA,DR,DIR

 S X="VREFBIQ"

 S DA(1)=TRANIEN

 S DIC(0)="L"

 S DIC="^BAREDI(""1T"","_DA(1)_",70,"

 D ^DIC

 I +Y>0 D

 .K DIE,DIC,DA,DR,DIR

 .S DA=+Y

 .S DA(1)=TRANIEN

 .S DIE="^BAREDI(""1T"","_DA(1)_",70,"

 .S BARVAL="VREFB|BAREDPA1"

 .S DR=".02///^S X=BARVAL"

 .D ^DIE

 K DIE,DIC,DA,DR,DIR

 S X="VREFBID"

 S DA(1)=TRANIEN

 S DIC(0)="L"

 S DIC="^BAREDI(""1T"","_DA(1)_",70,"

 D ^DIC

 I +Y>0 D

 .K DIE,DIC,DA,DR,DIR

 .S DA=+Y

 .S DA(1)=TRANIEN

 .S DIE="^BAREDI(""1T"","_DA(1)_",70,"

 .S BARVAL="VREFB|BAREDPA1"

 .S DR=".02///^S X=BARVAL"

 .D ^DIE

 K DIE,DIC,DA,DR,DIR

 S X="VIC"

 S DA(1)=TRANIEN

 S DIC(0)="L"

 S DIC="^BAREDI(""1T"","_DA(1)_",70,"

 D ^DIC

 I +Y>0 D

 .K DIE,DIC,DA,DR,DIR

 .S DA=+Y

 .S DA(1)=TRANIEN

 .S DIE="^BAREDI(""1T"","_DA(1)_",70,"

 .S BARVAL="VIC|BAREDPA1"

 .S DR=".02///^S X=BARVAL"

 .D ^DIE

PRE ;EP - PRE INSTALL - DELETE OLD DATA IN TABLES

 Q  ;PER ADRIAN DO NOT UPDATE TABLES UNTIL HE STRAIGHTENS IT OUT. APPEARS OUR TABLES ARE NOT UPDATED??

 ;I AM NOT SURE WE KNOW WHAT ENTRIES THEY SHOULD HAVE.

 ;W !,"DELETING OLD TABLE DATA.."

 ;S IEN=0 F  S IEN=$O(^BARTBL(IEN)) Q:IEN=""!(IEN>999)  W "." K ^BARTBL(IEN)

FIXADJ3 ;EP

 K DIE,DIR,DR,DA,DIC

 S DIE="^BARADJ("

 S DA=3

 S DR=".03///14;.04///27"

 D ^DIE

STUFFDCM ;

 D BMES^XPDUTL("Updating Debt Collection Target ID in ZISH SEND PARAMETERS file....")

 K DIC,DIE,DA,DR,DIR

 S TARGETID="asdstgw.d1.na.DOMAIN.NAME"

 F X="BAR DCM B","BAR DCM F" D

 .S DIC="^%ZIB(9888888.93,"

 .S DIC(0)=""

 .D ^DIC

 .Q:Y<0

 .S DIE=DIC

 .K DIC,DA,DR,DIR

 .S DA=+Y

 .S DR=".02////"_TARGETID

 .D ^DIE

ADDZISH ;EP - ADD ZISH ENTIRES TO 'ZISH SEND PARAMETERS' FILE

 ;ADD 'BAR UFMS B' BACKGROUND ENTRY

 ;ADD 'BAR UFMS F' FOREGROUND ENTRY

ADDF ;ADD FOREGROUND

 ;I $D(^%ZIB(9888888.93,"B","BAR UFMS F")) D

 ;IF ENTRY IS SET TO umftest THIS IS TEST SYSTEM - DO NOT UPDATE

 I $D(^%ZIB(9888888.93,"B","BAR UFMS F")) D  Q:$$GET1^DIQ(9888888.93,REC_",",.03)="ufmstest"  ;BAR*1.8*4

 .S REC=$O(^%ZIB(9888888.93,"B","BAR UFMS F",""))

 .D BMES^XPDUTL("Found [BAR UFMS F] as a ZISH SEND PARAMETER entry")

 D BMES^XPDUTL("Adding [BAR UFMS F] as a ZISH SEND PARAMETER entry")

 K DIC,DIE,DA,DR,DIR

 S DIC="^%ZIB(9888888.93,"

 S DIC(0)="L"

 S X="BAR UFMS F"

 D ^DIC

 I +Y<0 W !,"UNABLE TO ADD ZISH PARAMETER ENTRY. TRY MANUALLY!!" Q

 K DIC,DIE,DA,DR,DIR,DD,DO,DINUM

 S DIE="^%ZIB(9888888.93,"

 S DA=+Y

 S USERNAME="ufmsuser"

 S PASSWORD="vjrsshn9"

 S SENDCMD="sendto"

 S TYPE="F"

 ;S TARGETIP="quovadx-ie.DOMAIN.NAME"

 S TARGETIP="quovadx-ie"  ;BAR*1.8*4

 S ARGS="-i -u -a"

 S DR=".02///^S X=TARGETIP"

 S DR=DR_";.03///^S X=USERNAME"

 S DR=DR_";.04////^S X=PASSWORD"

 S DR=DR_";.06///^S X=ARGS"

 S DR=DR_";.07///^S X=TYPE"

 S DR=DR_";.08///^S X=SENDCMD"

 D ^DIE

 K DIC,DIE,DA,DR,DIR

ADDB ;ADD BACKGROUND

 ;I $D(^%ZIB(9888888.93,"B","BAR UFMS B")) D

 I $D(^%ZIB(9888888.93,"B","BAR UFMS B")) D  Q:$$GET1^DIQ(9888888.93,REC_",",.03)="ufmstest"  ;BAR*1.8*4

 .S REC=$O(^%ZIB(9888888.93,"B","BAR UFMS B",""))  ;BAR*1.8*4

 .D BMES^XPDUTL("Found [BAR UFMS B] as a ZISH SEND PARAMETER entry")

 D BMES^XPDUTL("Adding [BAR UFMS B] as a ZISH SEND PARAMETER entry")

 K DIC,DIE,DA,DR,DIR

 S DIC="^%ZIB(9888888.93,"

 S DIC(0)="L"

 S X="BAR UFMS B"

 D ^DIC

 I +Y<0 D BMES^XPDUTL("UNABLE TO ADD ZISH PARAMETER ENTRY. TRY MANUALLY!!")

 K DIC,DIE,DA,DR,DIR,DD,DO,DINUM

 S DIE="^%ZIB(9888888.93,"

 S DA=+Y

 S USERNAME="ufmsuser"

 S PASSWORD="vjrsshn9"

 S SENDCMD="sendto"

 S TYPE="B"

 ;S TARGETIP="quovadx-ie.DOMAIN.NAME"

 S TARGETIP="quovadx-ie"  ;BAR*1.8*4

 S ARGS="-i -u -a"

 S DR=".02///^S X=TARGETIP"

 S DR=DR_";.03///^S X=USERNAME"

 S DR=DR_";.04////^S X=PASSWORD"

 S DR=DR_";.06///^S X=ARGS"

 S DR=DR_";.07///^S X=TYPE"

 S DR=DR_";.08///^S X=SENDCMD"

 D ^DIE

 K DIC,DIE,DA,DR,DIR

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

INTROE ; Intro text during KIDS Environment check.

 ;;This distribution Modifies Accounts Receivable containing previous patch

 ;;modifications for version 1.8. This patch is 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.

 ;;###

BAREV185  ; IHS/SD/LSL - ENVIRONMENT CHECK V1.8 PATCH 5; 05/08/2008

 +1       ;;1.8;IHS ACCOUNTS RECEIVABLE;**1,2,3,4,5**;APR 27,2007

 +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      ;BAR*1.8*4 -- ONLY

 +12      ;ALL SESSIONS MUST BE TRANSPORTED BEFORE INSTALL OF PATCH 4

 +13       IF $PIECE($$INSTALLD("BAR","1.8",4),"*",3)'=1

               Begin DoDot:1

 +14               SET BAROK=1

 +15      ;ADD DEFAULT (#1504) UFMS DISPLAY DATE LIMIT

                   DO ADDDIS

 +16               DO TASK(DUZ(2),.BAROK)

 +17               IF 'BAROK

                       Begin DoDot:2

 +18                       WRITE !!,*7,*7

 +19                       WRITE $$CJ^XLFSTR("There are sessions that have not been transmitted",IOM)

 +20                       WRITE !,$$CJ^XLFSTR("Please give the A/R cashiers the above list",IOM)

 +21                       WRITE !,$$CJ^XLFSTR("Cannot proceed until all sessions are transmitted",IOM)

 +22                       DO SORRY(2)

                       End DoDot:2

                       QUIT

               End DoDot:1

 +23      ;

 +24      ; User's name

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

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

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

 +27      ;

 +28       NEW BARXU

 +29      ;RLT     ; Find current Kernel version and patch

           SET BARXU=$$INSTALLD("XU","8.0",1011)

 +30       IF $PIECE(BARXU,"*",2)<8

               SET BARXU=0

 +31      ;RLT

           IF $PIECE(BARXU,"*",3)'=1

               SET BARXU=0

 +32       WRITE !,$$CJ^XLFSTR("Need at least XU v8.0 Patch 1011..... "_$SELECT(BARXU=0:"NOT ",1:"")_"Present",IOM)

 +33       IF BARXU=0

               DO SORRY(2)

 +34      ;

 +35      ; FileMan V21.0

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

 +36      ;

 +37       NEW BARXB

 +38      ;RLT    ; Find current IHS utilities version and patch

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

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

               SET BARXB=0

 +40      ;RLT

           IF $PIECE(BARXU,"*",3)'=1

               SET BARXU=0

 +41       WRITE !,$$CJ^XLFSTR("Need at least XB v3.0 Patch 11..... "_$SELECT(BARXB=0:"NOT ",1:"")_"Present",IOM)

 +42       IF BARXB=0

               DO SORRY(2)

 +43      ;

 +44      ; Accounts Receivable V1.8

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

 +45      ;

 +46       NEW BARABM

 +47       SET BARABM=$$INSTALLD("ABM","2.5",13)

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

               SET BARABM=0

 +49       IF $PIECE(BARABM,"*",3)'=1

               SET BARABM=0

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

 +51       IF BARABM=0

               DO SORRY(2)

 +52      ;

 +53      ;

 +54       NEW DA,DIC

 +55       SET X="BAR"

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

 +57       SET DIC(0)=""

 +58       SET D="C"

 +59       DO IX^DIC

 +60       IF Y<0

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

                   Begin DoDot:1

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

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

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

 +64                   DO SORRY(2)

 +65                   QUIT

                   End DoDot:1

 +66      ;

 +67      ;LETS DOUBLE CHECK - MAKE SURE THEY SAVE THE GLOBALS OFF

 +68      ;DONE IF UPDATING A/R TABLES

 +69      ;I '$G(XPDQUIT) D

 +70      ;.W !!!,$$CJ^XLFSTR("IMPORTANT: PLEASE MAKE SURE YOU SAVE THE FOLLOWING GLOBALS TO DISK?",IOM)

 +71      ;.W !,$$CJ^XLFSTR("USE ^%GOGEN TO SAVE ^BAR(90052.01",IOM)

 +72      ;.W !,$$CJ^XLFSTR("USE ^%GO TO SAVE ^BARTBL",IOM)

 +73      ;

 +74       IF $GET(XPDQUIT)

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

               QUIT

 +75      ;

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

 +77       DO HELP^XBHELP("INTROE","BAREV184")

 +78      ;

 +79       IF $GET(XPDENV)=1

               Begin DoDot:1

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

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

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

 +83               DO HELP^XBHELP("INTROI","BAREV181")

 +84               QUIT

               End DoDot:1

 +85      ;

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

               DO SORRY(2)

 +87       QUIT

 +88      ; ********************************************************************

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_"*"_BARPATCH

 +16      ;

POST      ;EP - POST INSTALL OF ZISH ENTRIES AND QUEING OF BIZTALK TASK

 +1       ;Stuff too long target id into

           DO STUFFDCM

 +2       ;FIX A/R EDI STND CLAIM ADJ REASONS STANDARD ADJUSTMENT CODE 3

           DO FIXADJ3

 +3       ;                BAD ENTRY IN FIELD .03 (14;17) IM21683,IM23712

 +4       ;CHANGE THE AWO EXPIRATION DATE

           DO AWODT

 +5       ;ADD NEW WRITE OFF ENTRY IN BARTBL AT 916 SO IT DOESNOT GET OVERWRITTEN BY

           DO ADWO

 +6       ;                  NEW ENTRIES IN PATCH 2

 +7       ;EDIT "HIPAA 835 v4010" ENTRY IN A/R EDI TRANSPORT FILE

           DO EDIHIPAA

 +8       ;

 +9       ;set default value for field #22 in A/R COLLECTION POINT file

 +10       DO COLPOINT

 +11      ;

 +12      ;ADD ZISH SEND PARAMETER ENTRIES FOR UFMS

           DO ADDZISH

 +13       QUIT

TASK(SAFEDUZ2,BAROK) ;EP - FOR PATCH 4 ONLY

 +1       ;

 +2        KILL ^BARBOB("BARZ")

CKSESS    ;

 +1       ; Session status can be:   O    OPEN

 +2       ;                          RC   RECONCILED

 +3       ;                          RV   REVIEWED/APPROVED

 +4       ;                          T    TRANSMITTED

 +5       ;                          RT   RETRANSMITTED

 +6        KILL BAR

 +7        NEW BARLOC,BARST,BARUDUZ,BAR

 +8        SET DUZ(2)=0

 +9        FOR

               SET DUZ(2)=$ORDER(^BARSESS(DUZ(2)))

               IF 'DUZ(2)

                   QUIT

               Begin DoDot:1

 +10      ;CLEAN OUT NOT SENT BUCKET

                   KILL ^BARSESS(DUZ(2),"NS")

 +11               IF '$$IHS^BARUFUT(DUZ(2))

                       QUIT

 +12               SET BARLOC=$PIECE(^AUTTLOC(DUZ(2),0),U,2)

 +13               SET BARST=0

 +14               FOR

                       SET BARST=$ORDER(^BARSESS(DUZ(2),"C",BARST))

                       IF BARST=""

                           QUIT

                       Begin DoDot:2

 +15      ;DON'T WANT (RE)TRANSMITTED

                           IF BARST["TRANSMIT"

                               QUIT

 +16                       SET BARUDUZ=0

 +17                       FOR

                               SET BARUDUZ=$ORDER(^BARSESS(DUZ(2),"C",BARST,BARUDUZ))

                               IF 'BARUDUZ

                                   QUIT

                               Begin DoDot:3

 +18                               DO LOOP(BARUDUZ,BARST)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +19       IF '$DATA(BAR)

               QUIT

 +20       DO WRT

 +21       SET BAROK=0

 +22       SET DUZ(2)=SAFEDUZ2

 +23       QUIT

LOOP(UDUZ,STAT) ; - GET DATA FROM SESSION LEVEL

 +1        NEW SESSID,ERASTAT,CURSTAT,STATDATE,POSTING

 +2        SET CASHIER=$EXTRACT($PIECE($GET(^VA(200,UDUZ,0)),U),1,17)

 +3        SET SESSID=0

 +4        FOR

               SET SESSID=$ORDER(^BARSESS(DUZ(2),"C",STAT,UDUZ,SESSID))

               IF SESSID=""

                   QUIT

               Begin DoDot:1

 +5                SET IENS=SESSID_","_UDUZ_","

 +6                SET SESSDT=$$GET1^DIQ(90057.11,IENS,.01,"I")

 +7       ;IGNORE PRE-UFMS SESSIONS

                   IF SESSDT<3071001

                       QUIT

 +8                SET CURSTAT=$$GET1^DIQ(90057.11,IENS,.02,"E")

 +9                SET STATDATE=$$GET1^DIQ(90057.11,IENS,.03,"E")

 +10               SET ERASTAT=$EXTRACT($$GET1^DIQ(90057.11,IENS,.04,"E"))

 +11               SET POSTING=$$STILPOST^BARUFUT1(UDUZ)

 +12               SET Y=STATDATE

                   XECUTE ^DD("DD")

                   SET STATDATE=Y

 +13               SET BAR(CASHIER,BARLOC,STAT,SESSID)=""

               End DoDot:1

 +14       QUIT

WRT       ;

 +1        WRITE !!?25,"OPEN SESSIONS LIST FOR: "

 +2        WRITE !,"CASHIER",?22,"LOCATION",?45,"STATUS",?65,"SESSION ID",!

 +3        NEW A,B,C,D

 +4        SET A=""

 +5       ;CASHIER

FOR

               SET A=$ORDER(BAR(A))

               IF A=""

                   QUIT

               Begin DoDot:1

 +6                SET B=0

 +7       ;DUZ(2)

FOR

                       SET B=$ORDER(BAR(A,B))

                       IF B=""

                           QUIT

                       Begin DoDot:2

 +8                        SET C=0

 +9       ;STATUS

FOR

                               SET C=$ORDER(BAR(A,B,C))

                               IF C=""

                                   QUIT

                               Begin DoDot:3

 +10                               SET D=0

 +11                               WRITE A,?19,$EXTRACT(B,1,20),?40,$EXTRACT(C,1,20)

 +12      ;SESSION ID

FOR

                                       SET D=$ORDER(BAR(A,B,C,D))

                                       IF 'D

                                           QUIT

                                       Begin DoDot:4

 +13                                       WRITE ?62,D,!

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +14       QUIT

ADDDIS    ;EP -

 +1        KILL DIE,DR,DIC,DIE,DIR,DA

 +2       ;S DR="1504////^S X=""T-1W"";1505////30"""

 +3        SET X1=3071001

 +4        SET X2=DT

 +5        DO ^%DTC

 +6        SET BARDT=X

 +7        SET DUZ2=1

 +8        FOR

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

               IF 'DUZ2

                   QUIT

               Begin DoDot:1

 +9                SET DA(1)=DUZ2

 +10               SET DA=0

 +11               FOR

                       SET DA=$ORDER(^BAR(90052.06,DUZ2,DA))

                       IF 'DA

                           QUIT

                       Begin DoDot:2

 +12                       SET DR="1504////T"_BARDT

 +13      ;IHS/SD/TPF BAR*1.8*4 IM26189

                           SET DR=DR_";1505////30"""

 +14      ;FOR NON-IHS SITES

                           IF '$$IHS^BARUFUT(DA)

                               SET DR=DR_";1502////1;1503////1"

 +15                       SET DIE="^BAR(90052.06,"_DA(1)_","

 +16                       DO ^DIE

                       End DoDot:2

               End DoDot:1

 +17       QUIT

COLPOINT  ;EP -

 +1        KILL DIE,DR,DIC,DIE,DIR,DA

 +2        SET DR="22////^S X=1"

 +3        SET DUZ2=1

 +4       ;BAR*1.8*4

           NEW BART

 +5        FOR

               SET DUZ2=$ORDER(^BAR(90051.02,DUZ2))

               IF 'DUZ2

                   QUIT

               Begin DoDot:1

 +6                SET DA(1)=DUZ2

 +7                SET DA=0

 +8                FOR

                       SET DA=$ORDER(^BAR(90051.02,DUZ2,DA))

                       IF 'DA

                           QUIT

                       Begin DoDot:2

 +9       ;BAR*1.8*4

                           SET BART=$PIECE($GET(^BAR(90051.02,DUZ2,DA,0)),U,22)

 +10      ;DON'T OVERWRITE  ;BAR*1.8*4

                           IF BART'=""

                               QUIT

 +11                       SET DIE="^BAR(90051.02,"_DA(1)_","

 +12                       DO ^DIE

                       End DoDot:2

               End DoDot:1

 +13       QUIT

ADWO      ; EP

 +1        NEW ADWO

 +2        SET ADWO="^BARTBL(916,0)"

 +3        SET @ADWO="AUTO WRITE-OFF 2007^3^WO"

 +4        SET DIK="^BARTBL("

           DO IXALL^DIK

 +5        QUIT

AWODT     ;EP -

 +1        KILL DIR,DIE,DIC,DA,DR

 +2        SET DR="15////^S X=3070525"

 +3        SET DUZ2=1

 +4        FOR

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

               IF 'DUZ2

                   QUIT

               Begin DoDot:1

 +5                SET DIE="^BAR(90052.06,"_DUZ2_","

 +6                SET DA=DUZ2

 +7                DO ^DIE

               End DoDot:1

 +8        QUIT

EDIHIPAA  ;EP - EDIT HIPAA TRANSPORT ENTRY

 +1        NEW TRANIEN

 +2        SET TRANIEN=$ORDER(^BAREDI("1T","B","HIPAA 835 v4010",""))

 +3        IF 'TRANIEN

               Begin DoDot:1

 +4                WRITE !,$$CJ^XLFSTR("CANNOT FIND HIPAA 835 v4010 ENTRY!!",IOM)

 +5                WRITE !,$$CJ^XLFSTR("INFORM THE HELP DESK IMMEDIATELY!!",IOM)

               End DoDot:1

               QUIT

 +6       ;BEGIN UPDATING FIELDS

 +7       ;

 +8       ;EDIT SEGMENT 2-080.B-N1

 +9       ;IDENTIFICATION CODE QUALIFIER

 +10       KILL DIE,DIC,DA,DR,DIR

 +11       SET DA(2)=TRANIEN

 +12       SET DA(1)=15

 +13       SET DA=3

 +14       SET DIE="^BAREDI(""1T"","_DA(2)_",10,"_DA(1)_",10,"

 +15       SET BARVAL="VICQ"

 +16       SET DR=".08///^S X=BARVAL"

 +17       DO ^DIE

 +18      ;

 +19      ;IDENTIFICATION CODE

 +20       KILL DIE,DIC,DA,DR,DIR

 +21       SET DA(2)=TRANIEN

 +22       SET DA(1)=15

 +23       SET DA=4

 +24       SET DIE="^BAREDI(""1T"","_DA(2)_",10,"_DA(1)_",10,"

 +25       SET BARVAL="VIC"

 +26       SET DR=".08///^S X=BARVAL"

 +27       DO ^DIE

 +28      ;

 +29      ;REFERENCE ID QUALIFIER

 +30       KILL DIE,DIC,DA,DR,DIR

 +31       SET DA(2)=TRANIEN

 +32       SET DA(1)=18

 +33       SET DA=1

 +34       SET DIE="^BAREDI(""1T"","_DA(2)_",10,"_DA(1)_",10,"

 +35       SET BARVAL="VREFBIQ"

 +36       SET DR=".08///^S X=BARVAL"

 +37       DO ^DIE

 +38      ;

 +39      ;REFERENCE IDENTIFICATION

 +40       KILL DIE,DIC,DA,DR,DIR

 +41       SET DA(2)=TRANIEN

 +42       SET DA(1)=18

 +43       SET DA=2

 +44       SET DIE="^BAREDI(""1T"","_DA(2)_",10,"_DA(1)_",10,"

 +45       SET BARVAL="VREFBID"

 +46       SET DR=".08///^S X=BARVAL"

 +47       DO ^DIE

 +48      ;

 +49      ;VARIABLE PROCESSING

 +50       KILL DIE,DIC,DA,DR,DIR

 +51       SET X="VREFBIQ"

 +52       SET DA(1)=TRANIEN

 +53       SET DIC(0)="L"

 +54       SET DIC="^BAREDI(""1T"","_DA(1)_",70,"

 +55       DO ^DIC

 +56       IF +Y>0

               Begin DoDot:1

 +57               KILL DIE,DIC,DA,DR,DIR

 +58               SET DA=+Y

 +59               SET DA(1)=TRANIEN

 +60               SET DIE="^BAREDI(""1T"","_DA(1)_",70,"

 +61               SET BARVAL="VREFB|BAREDPA1"

 +62               SET DR=".02///^S X=BARVAL"

 +63               DO ^DIE

               End DoDot:1

 +64      ;

 +65       KILL DIE,DIC,DA,DR,DIR

 +66       SET X="VREFBID"

 +67       SET DA(1)=TRANIEN

 +68       SET DIC(0)="L"

 +69       SET DIC="^BAREDI(""1T"","_DA(1)_",70,"

 +70       DO ^DIC

 +71       IF +Y>0

               Begin DoDot:1

 +72               KILL DIE,DIC,DA,DR,DIR

 +73               SET DA=+Y

 +74               SET DA(1)=TRANIEN

 +75               SET DIE="^BAREDI(""1T"","_DA(1)_",70,"

 +76               SET BARVAL="VREFB|BAREDPA1"

 +77               SET DR=".02///^S X=BARVAL"

 +78               DO ^DIE

               End DoDot:1

 +79      ;

 +80       KILL DIE,DIC,DA,DR,DIR

 +81       SET X="VIC"

 +82       SET DA(1)=TRANIEN

 +83       SET DIC(0)="L"

 +84       SET DIC="^BAREDI(""1T"","_DA(1)_",70,"

 +85       DO ^DIC

 +86       IF +Y>0

               Begin DoDot:1

 +87               KILL DIE,DIC,DA,DR,DIR

 +88               SET DA=+Y

 +89               SET DA(1)=TRANIEN

 +90               SET DIE="^BAREDI(""1T"","_DA(1)_",70,"

 +91               SET BARVAL="VIC|BAREDPA1"

 +92               SET DR=".02///^S X=BARVAL"

 +93               DO ^DIE

               End DoDot:1

 +94       QUIT

 +95      ;

PRE       ;EP - PRE INSTALL - DELETE OLD DATA IN TABLES

 +1       ;PER ADRIAN DO NOT UPDATE TABLES UNTIL HE STRAIGHTENS IT OUT. APPEARS OUR TABLES ARE NOT UPDATED??

           QUIT

 +2       ;I AM NOT SURE WE KNOW WHAT ENTRIES THEY SHOULD HAVE.

 +3       ;W !,"DELETING OLD TABLE DATA.."

 +4       ;S IEN=0 F  S IEN=$O(^BARTBL(IEN)) Q:IEN=""!(IEN>999)  W "." K ^BARTBL(IEN)

 +5        QUIT

FIXADJ3   ;EP

 +1        KILL DIE,DIR,DR,DA,DIC

 +2        SET DIE="^BARADJ("

 +3        SET DA=3

 +4        SET DR=".03///14;.04///27"

 +5        DO ^DIE

 +6        QUIT

STUFFDCM  ;

 +1        DO BMES^XPDUTL("Updating Debt Collection Target ID in ZISH SEND PARAMETERS file....")

 +2        KILL DIC,DIE,DA,DR,DIR

 +3        SET TARGETID="asdstgw.d1.na.DOMAIN.NAME"

 +4        FOR X="BAR DCM B","BAR DCM F"

               Begin DoDot:1

 +5                SET DIC="^%ZIB(9888888.93,"

 +6                SET DIC(0)=""

 +7                DO ^DIC

 +8                IF Y<0

                       QUIT

 +9                SET DIE=DIC

 +10               KILL DIC,DA,DR,DIR

 +11               SET DA=+Y

 +12               SET DR=".02////"_TARGETID

 +13               DO ^DIE

               End DoDot:1

 +14       QUIT

ADDZISH   ;EP - ADD ZISH ENTIRES TO 'ZISH SEND PARAMETERS' FILE

 +1       ;ADD 'BAR UFMS B' BACKGROUND ENTRY

 +2       ;ADD 'BAR UFMS F' FOREGROUND ENTRY

ADDF      ;ADD FOREGROUND

 +1       ;I $D(^%ZIB(9888888.93,"B","BAR UFMS F")) D

 +2       ;IF ENTRY IS SET TO umftest THIS IS TEST SYSTEM - DO NOT UPDATE

 +3       ;BAR*1.8*4

           IF $DATA(^%ZIB(9888888.93,"B","BAR UFMS F"))

               Begin DoDot:1

 +4                SET REC=$ORDER(^%ZIB(9888888.93,"B","BAR UFMS F",""))

 +5                DO BMES^XPDUTL("Found [BAR UFMS F] as a ZISH SEND PARAMETER entry")

               End DoDot:1

               IF $$GET1^DIQ(9888888.93,REC_",",.03)="ufmstest"

                   QUIT

 +6        DO BMES^XPDUTL("Adding [BAR UFMS F] as a ZISH SEND PARAMETER entry")

 +7        KILL DIC,DIE,DA,DR,DIR

 +8        SET DIC="^%ZIB(9888888.93,"

 +9        SET DIC(0)="L"

 +10       SET X="BAR UFMS F"

 +11       DO ^DIC

 +12       IF +Y<0

               WRITE !,"UNABLE TO ADD ZISH PARAMETER ENTRY. TRY MANUALLY!!"

               QUIT

 +13       KILL DIC,DIE,DA,DR,DIR,DD,DO,DINUM

 +14       SET DIE="^%ZIB(9888888.93,"

 +15       SET DA=+Y

 +16       SET USERNAME="ufmsuser"

 +17       SET PASSWORD="vjrsshn9"

 +18       SET SENDCMD="sendto"

 +19       SET TYPE="F"

 +20      ;S TARGETIP="quovadx-ie.DOMAIN.NAME"

 +21      ;BAR*1.8*4

           SET TARGETIP="quovadx-ie"

 +22       SET ARGS="-i -u -a"

 +23       SET DR=".02///^S X=TARGETIP"

 +24       SET DR=DR_";.03///^S X=USERNAME"

 +25       SET DR=DR_";.04////^S X=PASSWORD"

 +26       SET DR=DR_";.06///^S X=ARGS"

 +27       SET DR=DR_";.07///^S X=TYPE"

 +28       SET DR=DR_";.08///^S X=SENDCMD"

 +29       DO ^DIE

 +30       KILL DIC,DIE,DA,DR,DIR

ADDB      ;ADD BACKGROUND

 +1       ;I $D(^%ZIB(9888888.93,"B","BAR UFMS B")) D

 +2       ;BAR*1.8*4

           IF $DATA(^%ZIB(9888888.93,"B","BAR UFMS B"))

               Begin DoDot:1

 +3       ;BAR*1.8*4

                   SET REC=$ORDER(^%ZIB(9888888.93,"B","BAR UFMS B",""))

 +4                DO BMES^XPDUTL("Found [BAR UFMS B] as a ZISH SEND PARAMETER entry")

               End DoDot:1

               IF $$GET1^DIQ(9888888.93,REC_",",.03)="ufmstest"

                   QUIT

 +5        DO BMES^XPDUTL("Adding [BAR UFMS B] as a ZISH SEND PARAMETER entry")

 +6        KILL DIC,DIE,DA,DR,DIR

 +7        SET DIC="^%ZIB(9888888.93,"

 +8        SET DIC(0)="L"

 +9        SET X="BAR UFMS B"

 +10       DO ^DIC

 +11       IF +Y<0

               DO BMES^XPDUTL("UNABLE TO ADD ZISH PARAMETER ENTRY. TRY MANUALLY!!")

 +12       KILL DIC,DIE,DA,DR,DIR,DD,DO,DINUM

 +13       SET DIE="^%ZIB(9888888.93,"

 +14       SET DA=+Y

 +15       SET USERNAME="ufmsuser"

 +16       SET PASSWORD="vjrsshn9"

 +17       SET SENDCMD="sendto"

 +18       SET TYPE="B"

 +19      ;S TARGETIP="quovadx-ie.DOMAIN.NAME"

 +20      ;BAR*1.8*4

           SET TARGETIP="quovadx-ie"

 +21       SET ARGS="-i -u -a"

 +22       SET DR=".02///^S X=TARGETIP"

 +23       SET DR=DR_";.03///^S X=USERNAME"

 +24       SET DR=DR_";.04////^S X=PASSWORD"

 +25       SET DR=DR_";.06///^S X=ARGS"

 +26       SET DR=DR_";.07///^S X=TYPE"

 +27       SET DR=DR_";.08///^S X=SENDCMD"

 +28       DO ^DIE

 +29       KILL DIC,DIE,DA,DR,DIR

 +30       QUIT

 +31      ; ********************************************************************

INTROE    ; Intro text during KIDS Environment check.

 +1       ;;This distribution Modifies Accounts Receivable containing previous patch

 +2       ;;modifications for version 1.8. This patch is cumulative.

 +3       ;;

 +4       ;;###

 +5       ;;

 +6       ;

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

BAREV185.m