BAREV182 ; IHS/SD/LSL - ENVIRONMENT CHECK V1.8 PATCH 2 NPI;
;;1.8;IHS ACCOUNTS RECEIVABLE;**1,2**;MAY 22,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)
;
;I $$VCHK("XU","8.0",2) ; Kernel V8.0
N BARXU
;S BARXU=$$INSTALLD("XU") ;RLT ; Find current Kernel version and patch
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
;I $P(BARXU,"*",2)>7,$P(BARXU,"*",2)<9,$P(BARXU,"*",3)<1010 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") ;RLT ; Find current IHS utilities version and patch
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
;I $P(BARXB,"*",2)>2,$P(BARXB,"*",2)<4,$P(BARXB,"*",3)<10 S BARXB=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 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","BAREV181")
;
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
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=3070529"
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 -
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
; ********************************************************************
INTROE ; Intro text during KIDS Environment check.
;;This distribution Modifies Accounts Receivable containing previous patch
;;modifications and:
;;
;;###
;;
;
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.
;;###
BAREV182 ; IHS/SD/LSL - ENVIRONMENT CHECK V1.8 PATCH 2 NPI;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**1,2**;MAY 22,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 ;I $$VCHK("XU","8.0",2) ; Kernel V8.0
+19 NEW BARXU
+20 ;S BARXU=$$INSTALLD("XU") ;RLT ; Find current Kernel version and patch
+21 ;RLT ; Find current Kernel version and patch
SET BARXU=$$INSTALLD("XU","8.0",1011)
+22 IF $PIECE(BARXU,"*",2)<8
SET BARXU=0
+23 ;RLT
IF $PIECE(BARXU,"*",3)'=1
SET BARXU=0
+24 ;I $P(BARXU,"*",2)>7,$P(BARXU,"*",2)<9,$P(BARXU,"*",3)<1010 S BARXU=0 ;RLT
+25 WRITE !,$$CJ^XLFSTR("Need at least XU v8.0 Patch 1011..... "_$SELECT(BARXU=0:"NOT ",1:"")_"Present",IOM)
+26 IF BARXU=0
DO SORRY(2)
+27 ;
+28 ; FileMan V21.0
IF $$VCHK("DI","21.0",2)
+29 ;
+30 NEW BARXB
+31 ;S BARXB=$$INSTALLD("XB") ;RLT ; Find current IHS utilities version and patch
+32 ;RLT ; Find current IHS utilities version and patch
SET BARXB=$$INSTALLD("XB","3.0",11)
+33 IF $PIECE(BARXB,"*",2)<3
SET BARXB=0
+34 ;RLT
IF $PIECE(BARXU,"*",3)'=1
SET BARXU=0
+35 ;I $P(BARXB,"*",2)>2,$P(BARXB,"*",2)<4,$P(BARXB,"*",3)<10 S BARXB=0 ;RLT
+36 WRITE !,$$CJ^XLFSTR("Need at least XB v3.0 Patch 11..... "_$SELECT(BARXB=0:"NOT ",1:"")_"Present",IOM)
+37 IF BARXB=0
DO SORRY(2)
+38 ;
+39 ; Accounts Receivable V1.8
IF $$VCHK("BAR","1.8",2)
+40 ;
+41 ; At least Third Party Billing V2.5 Patch 1 by looking for routine ABMUTLP in routine file
+42 NEW BARABM
+43 SET BARABM=$$VERSION^XPDUTL("ABM")
+44 IF BARABM'>2.5
SET BARABM=$DATA(^DIC(9.8,"B","ABMUTLP"))
+45 WRITE !,$$CJ^XLFSTR("Need at least ABM v2.5 Patch 1..... "_$SELECT(BARABM=0:"NOT ",1:"")_" Present",IOM)
+46 IF BARABM=0
DO SORRY(2)
+47 ;
+48 NEW DA,DIC
+49 SET X="BAR"
+50 SET DIC="^DIC(9.4,"
+51 SET DIC(0)=""
+52 SET D="C"
+53 DO IX^DIC
+54 IF Y<0
IF $DATA(^DIC(9.4,"C","BAR"))
Begin DoDot:1
+55 WRITE !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM)
+56 WRITE !,$$CJ^XLFSTR("PACKAGE File with an ""BAR"" prefix.",IOM)
+57 WRITE !,$$CJ^XLFSTR("One entry needs to be deleted.",IOM)
+58 DO SORRY(2)
+59 QUIT
End DoDot:1
+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","BAREV181")
+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","BAREV181")
+71 QUIT
End DoDot:1
+72 ;
+73 IF '$$DIR^XBDIR("E","","","","","",1)
DO SORRY(2)
+74 QUIT
+75 ; ********************************************************************
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
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 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=3070529"
+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
PRE ;EP -
+1 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
+15 ; ********************************************************************
INTROE ; Intro text during KIDS Environment check.
+1 ;;This distribution Modifies Accounts Receivable containing previous patch
+2 ;;modifications and:
+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 ;;###
