BAREV183 ; IHS/SD/LSL - ENVIRONMENT CHECK V1.8 PATCH 2 UFMS SESSION LOGGING;
;;1.8;IHS ACCOUNTS RECEIVABLE;**1,2,3**;APR 27,2007
;
;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)
;
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
;
; 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 BARABM
S BARABM=$$INSTALLD("ABM","2.5",12)
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 12..... "_$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
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","BAREV182")
;
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)
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.
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
;
D ADDDIS ;ADD DEFAULT (#1504) UFMS DISPLAY DATE LIMIT
;
Q
ADDDIS ;EP -
K DIE,DR,DIC,DIE,DIR,DA
S DR="1504////^S X=""T-1W"";1505////30"""
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
..I '$$IHS^BARUFUT(DA) S DR=DR_";1502////1;1503////1" ;FOR NON-IHS SITES
..S DIE="^BAR(90052.06,"_DA(1)_","
..D ^DIE
Q
COLPOINT ;EP -
K DIE,DR,DIC,DIE,DIR,DA
S DR="22////^S X=1"
S DUZ2=1
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 DIE="^BAR(90051.02,"_DA(1)_","
..D ^DIE
Q
ADWO ; EP
N ADWO
S ADWO="^BARTBL(916,0)"
S @ADWO="AUTO WRITE-OFF 2007^3^WO"
S DIK="^BARTBL(" D IXALL^DIK
Q
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
Q
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
Q
;
PRE ;EP - PRE INSTALL - DELETE OLD DATA IN TABLES
W !,"DELETING OLD TABLE DATA.."
S IEN=0 F S IEN=$O(^BARTBL(IEN)) Q:IEN=""!(IEN>999) W "." K ^BARTBL(IEN)
Q
FIXADJ3 ;EP
Q:$$GET1^DIQ(90056.06,"3,",.03,"I")'="14;17"
K DIE,DIR,DR,DA,DIC
S DIE="^BARADJ("
S DA=3
S DR=".03///14;.04///27"
D ^DIE
Q
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
Q
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
.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 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
.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 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
Q
; ********************************************************************
INTROE ; Intro text during KIDS Environment check.
;;This distribution Modifies Accounts Receivable containing previous patch
;;modifications fpr veriosn 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.
;;###
BAREV183 ; IHS/SD/LSL - ENVIRONMENT CHECK V1.8 PATCH 2 UFMS SESSION LOGGING;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**1,2,3**;APR 27,2007
+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 NEW BARXU
+19 ;RLT ; Find current Kernel version and patch
SET BARXU=$$INSTALLD("XU","8.0",1011)
+20 IF $PIECE(BARXU,"*",2)<8
SET BARXU=0
+21 ;RLT
IF $PIECE(BARXU,"*",3)'=1
SET BARXU=0
+22 WRITE !,$$CJ^XLFSTR("Need at least XU v8.0 Patch 1011..... "_$SELECT(BARXU=0:"NOT ",1:"")_"Present",IOM)
+23 IF BARXU=0
DO SORRY(2)
+24 ;
+25 ; FileMan V21.0
IF $$VCHK("DI","21.0",2)
+26 ;
+27 NEW BARXB
+28 ;RLT ; Find current IHS utilities version and patch
SET BARXB=$$INSTALLD("XB","3.0",11)
+29 IF $PIECE(BARXB,"*",2)<3
SET BARXB=0
+30 ;RLT
IF $PIECE(BARXU,"*",3)'=1
SET BARXU=0
+31 WRITE !,$$CJ^XLFSTR("Need at least XB v3.0 Patch 11..... "_$SELECT(BARXB=0:"NOT ",1:"")_"Present",IOM)
+32 IF BARXB=0
DO SORRY(2)
+33 ;
+34 ; Accounts Receivable V1.8
IF $$VCHK("BAR","1.8",2)
+35 ;
+36 ; At least Third Party Billing V2.5 Patch 1 by looking for routine ABMUTLP in routine file
+37 ;N BARABM
+38 ;S BARABM=$$VERSION^XPDUTL("ABM")
+39 ;I BARABM'>2.5 S BARABM=$D(^DIC(9.8,"B","ABMUTLP"))
+40 ;W !,$$CJ^XLFSTR("Need at least ABM v2.5 Patch 1..... "_$S(BARABM=0:"NOT ",1:"")_" Present",IOM)
+41 ;I BARABM=0 D SORRY(2)
+42 ;
+43 NEW BARABM
+44 SET BARABM=$$INSTALLD("ABM","2.5",12)
+45 IF $PIECE(BARABM,"*",2)<2.5
SET BARABM=0
+46 IF $PIECE(BARABM,"*",3)'=1
SET BARABM=0
+47 WRITE !,$$CJ^XLFSTR("Need at least Third Party Billing v2.5 Patch 12..... "_$SELECT(BARABM=0:"NOT ",1:"")_"Present",IOM)
+48 IF BARABM=0
DO SORRY(2)
+49 ;
+50 ;
+51 NEW DA,DIC
+52 SET X="BAR"
+53 SET DIC="^DIC(9.4,"
+54 SET DIC(0)=""
+55 SET D="C"
+56 DO IX^DIC
+57 IF Y<0
IF $DATA(^DIC(9.4,"C","BAR"))
Begin DoDot:1
+58 WRITE !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM)
+59 WRITE !,$$CJ^XLFSTR("PACKAGE File with an ""BAR"" prefix.",IOM)
+60 WRITE !,$$CJ^XLFSTR("One entry needs to be deleted.",IOM)
+61 DO SORRY(2)
+62 QUIT
End DoDot:1
+63 ;
+64 ;LETS DOUBLE CHECK - MAKE SURE THEY SAVE THE GLOBALS OFF
+65 IF '$GET(XPDQUIT)
Begin DoDot:1
+66 WRITE !!!,$$CJ^XLFSTR("IMPORTANT: PLEASE MAKE SURE YOU SAVE THE FOLLOWING GLOBALS TO DISK?",IOM)
+67 WRITE !,$$CJ^XLFSTR("USE ^%GOGEN TO SAVE ^BAR(90052.01",IOM)
+68 WRITE !,$$CJ^XLFSTR("USE ^%GO TO SAVE ^BARTBL",IOM)
End DoDot:1
+69 ;
+70 IF $GET(XPDQUIT)
WRITE !,$$CJ^XLFSTR("FIX IT! Before Proceeding.",IOM),!!,*7,*7,*7
QUIT
+71 ;
+72 WRITE !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
+73 DO HELP^XBHELP("INTROE","BAREV182")
+74 ;
+75 IF $GET(XPDENV)=1
Begin DoDot:1
+76 ; The following line prevents the "Disable Options..." and "Move
+77 ; Routines..." questions from being asked during the install.
+78 SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+79 DO HELP^XBHELP("INTROI","BAREV181")
+80 QUIT
End DoDot:1
+81 ;
+82 IF '$$DIR^XBDIR("E","","","","","",1)
DO SORRY(2)
+83 QUIT
+84 ; ********************************************************************
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 ;
+14 ;ADD DEFAULT (#1504) UFMS DISPLAY DATE LIMIT
DO ADDDIS
+15 ;
+16 QUIT
ADDDIS ;EP -
+1 KILL DIE,DR,DIC,DIE,DIR,DA
+2 SET DR="1504////^S X=""T-1W"";1505////30"""
+3 SET DUZ2=1
+4 FOR
SET DUZ2=$ORDER(^BAR(90052.06,DUZ2))
IF 'DUZ2
QUIT
Begin DoDot:1
+5 SET DA(1)=DUZ2
+6 SET DA=0
+7 FOR
SET DA=$ORDER(^BAR(90052.06,DUZ2,DA))
IF 'DA
QUIT
Begin DoDot:2
+8 ;FOR NON-IHS SITES
IF '$$IHS^BARUFUT(DA)
SET DR=DR_";1502////1;1503////1"
+9 SET DIE="^BAR(90052.06,"_DA(1)_","
+10 DO ^DIE
End DoDot:2
End DoDot:1
+11 QUIT
COLPOINT ;EP -
+1 KILL DIE,DR,DIC,DIE,DIR,DA
+2 SET DR="22////^S X=1"
+3 SET DUZ2=1
+4 FOR
SET DUZ2=$ORDER(^BAR(90051.02,DUZ2))
IF 'DUZ2
QUIT
Begin DoDot:1
+5 SET DA(1)=DUZ2
+6 SET DA=0
+7 FOR
SET DA=$ORDER(^BAR(90051.02,DUZ2,DA))
IF 'DA
QUIT
Begin DoDot:2
+8 SET DIE="^BAR(90051.02,"_DA(1)_","
+9 DO ^DIE
End DoDot:2
End DoDot:1
+10 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 WRITE !,"DELETING OLD TABLE DATA.."
+2 SET IEN=0
FOR
SET IEN=$ORDER(^BARTBL(IEN))
IF IEN=""!(IEN>999)
QUIT
WRITE "."
KILL ^BARTBL(IEN)
+3 QUIT
FIXADJ3 ;EP
+1 IF $$GET1^DIQ(90056.06,"3,",.03,"I")'="14;17"
QUIT
+2 KILL DIE,DIR,DR,DA,DIC
+3 SET DIE="^BARADJ("
+4 SET DA=3
+5 SET DR=".03///14;.04///27"
+6 DO ^DIE
+7 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 IF $DATA(^%ZIB(9888888.93,"B","BAR UFMS F"))
Begin DoDot:1
+2 DO BMES^XPDUTL("Found [BAR UFMS F] as a ZISH SEND PARAMETER entry")
End DoDot:1
+3 DO BMES^XPDUTL("Adding [BAR UFMS F] as a ZISH SEND PARAMETER entry")
+4 KILL DIC,DIE,DA,DR,DIR
+5 SET DIC="^%ZIB(9888888.93,"
+6 SET DIC(0)="L"
+7 SET X="BAR UFMS F"
+8 DO ^DIC
+9 IF +Y<0
WRITE !,"UNABLE TO ADD ZISH PARAMETER ENTRY. TRY MANUALLY!!"
QUIT
+10 KILL DIC,DIE,DA,DR,DIR,DD,DO,DINUM
+11 SET DIE="^%ZIB(9888888.93,"
+12 SET DA=+Y
+13 SET USERNAME="ufmsuser"
+14 SET PASSWORD="vjrsshn9"
+15 SET SENDCMD="sendto"
+16 SET TYPE="F"
+17 SET TARGETIP="quovadx-ie.DOMAIN.NAME"
+18 SET ARGS="-i -u -a"
+19 SET DR=".02///^S X=TARGETIP"
+20 SET DR=DR_";.03///^S X=USERNAME"
+21 SET DR=DR_";.04////^S X=PASSWORD"
+22 SET DR=DR_";.06///^S X=ARGS"
+23 SET DR=DR_";.07///^S X=TYPE"
+24 SET DR=DR_";.08///^S X=SENDCMD"
+25 DO ^DIE
+26 KILL DIC,DIE,DA,DR,DIR
ADDB ;ADD BACKGROUND
+1 IF $DATA(^%ZIB(9888888.93,"B","BAR UFMS B"))
Begin DoDot:1
+2 DO BMES^XPDUTL("Found [BAR UFMS B] as a ZISH SEND PARAMETER entry")
End DoDot:1
+3 DO BMES^XPDUTL("Adding [BAR UFMS B] as a ZISH SEND PARAMETER entry")
+4 KILL DIC,DIE,DA,DR,DIR
+5 SET DIC="^%ZIB(9888888.93,"
+6 SET DIC(0)="L"
+7 SET X="BAR UFMS B"
+8 DO ^DIC
+9 IF +Y<0
DO BMES^XPDUTL("UNABLE TO ADD ZISH PARAMETER ENTRY. TRY MANUALLY!!")
+10 KILL DIC,DIE,DA,DR,DIR,DD,DO,DINUM
+11 SET DIE="^%ZIB(9888888.93,"
+12 SET DA=+Y
+13 SET USERNAME="ufmsuser"
+14 SET PASSWORD="vjrsshn9"
+15 SET SENDCMD="sendto"
+16 SET TYPE="B"
+17 SET TARGETIP="quovadx-ie.DOMAIN.NAME"
+18 SET ARGS="-i -u -a"
+19 SET DR=".02///^S X=TARGETIP"
+20 SET DR=DR_";.03///^S X=USERNAME"
+21 SET DR=DR_";.04////^S X=PASSWORD"
+22 SET DR=DR_";.06///^S X=ARGS"
+23 SET DR=DR_";.07///^S X=TYPE"
+24 SET DR=DR_";.08///^S X=SENDCMD"
+25 DO ^DIE
+26 KILL DIC,DIE,DA,DR,DIR
+27 QUIT
+28 ; ********************************************************************
INTROE ; Intro text during KIDS Environment check.
+1 ;;This distribution Modifies Accounts Receivable containing previous patch
+2 ;;modifications fpr veriosn 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 ;;###
