IBCIUT4 ;DSI/SLM - MISC UTILITIES ;29-JAN-2001
;;2.0;INTEGRATED BILLING;**161,226,348**;21-MAR-94;Build 5
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
Q
COMERR ;create msg for comm error
NEW L,L1,MGROUP,TEXT,IBCISMG,IBCIERR
I '$D(IBCICLNP) S IBCICLNP=$P(^DGCR(399,IBIFN,0),U)
S MGROUP=$P(^IBE(350.9,1,50),U,4),MGROUP=$P(^XMB(3.8,MGROUP,0),U),L1=1
S IBCIERR=$$P1(PROBLEM)
D SNTMSG
S TEXT(L1)=" ** CLAIMSMANAGER COMMUNICATIONS ERROR **",L1=L1+1
S TEXT(L1)=" ",L1=L1+1
S TEXT(L1)="While attempting to send claim # "_IBCICLNP_", Error Code # "_$P(IBCIERR,U,1),L1=L1+1
S TEXT(L1)="was generated.",L1=L1+1
S TEXT(L1)=" ",L1=L1+1
S TEXT(L1)="User attempted "_IBCISMG,L1=L1+1
S TEXT(L1)=" ",L1=L1+1
S TEXT(L1)="Error Description:",L1=L1+1
S TEXT(L1)=" ",L1=L1+1
S TEXT(L1)=$P(IBCIERR,U,2),L1=L1+1
S TEXT(L1)=" ",L1=L1+1
I $P(IBCIERR,U,3)'="" D
. S TEXT(L1)="ClaimsManager Error Message:",L1=L1+1
. S TEXT(L1)=" ",L1=L1+1
. S TEXT(L1)=$P($P(IBCIERR,U,3)," - ",1),L1=L1+1
. S TEXT(L1)=$P($P(IBCIERR,U,3,99)," - ",2,99),L1=L1+1
. S TEXT(L1)=" ",L1=L1+1
. Q
;
; esg - 10/29/01 - Direct the reader to the Clear CM Results Queue
; option if the problem does not go away.
;
I PROBLEM=99 S TEXT(L1)="Please correct the problem and send again.",L1=L1+1
E D
. S TEXT(L1)="If this problem persists, then please try running the",L1=L1+1
. S TEXT(L1)="option to clear out the ClaimsManager results queue.",L1=L1+1
. S TEXT(L1)="This option name is IBCI CLEAR CLAIMSMANAGER QUEUE.",L1=L1+1
. Q
S TEXT(L1)=" ",L1=L1+1
S TEXT(L1)="Bill Sent By: "_$P(^VA(200,DUZ,0),U)
S XMSUB="ClaimsManager Communications Error sending "_IBCICLNP
S XMDUZ="ClaimsManager Interface",XMTEXT="TEXT(",XMY("G."_MGROUP)=""
D ^XMD
K XMSUB,XMDUZ,XMTEXT,TEXT
Q
GENERR(IBIFN,IBCIETP) ;create msg for general error
Q:IBCISNT'=2
NEW L,L1,L2,L3,MGROUP,TEXT,XMTEXT,XMY,XMSUB,XMDUZ,USER,IBCISMG,IBCIE1
I '$D(IBCICLNP) S IBCICLNP=$P(^DGCR(399,IBIFN,0),U)
S MGROUP=$P(^IBE(350.9,1,50),U,3),MGROUP=$P(^XMB(3.8,MGROUP,0),U),L1=1
D SNTMSG
S TEXT(L1)="User attempted "_IBCISMG,L1=L1+1
S TEXT(L1)=" ",L1=L1+1
;pull error msg from 351.9 based on mnemonic (IBCIETP) error type
S IBCIE1=0 F S IBCIE1=$O(^IBA(351.9,IBIFN,1,"B",IBCIETP,IBCIE1)) Q:'IBCIE1 D
.S TEXT(L1)="Line Item: "_+$P(^IBA(351.9,IBIFN,1,IBCIE1,0),U,2),L1=L1+1
.S TEXT(L1)="Error Mnemonic: "_$P(^IBA(351.9,IBIFN,1,IBCIE1,0),U),L1=L1+1
.S TEXT(L1)="Error Level: "_$P(^IBA(351.9,IBIFN,1,IBCIE1,0),"~",2),L1=L1+1
.S TEXT(L1)=" ",L1=L1+1
.S TEXT(L1)="Error Message:",L1=L1+1
.S L2=0 F S L2=$O(^IBA(351.9,IBIFN,1,IBCIE1,L2)) Q:'L2 D
..S L3=0 F S L3=$O(^IBA(351.9,IBIFN,1,IBCIE1,L2,L3)) Q:'L3 D
...S TEXT(L1)=^IBA(351.9,IBIFN,1,IBCIE1,L2,L3,0),L1=L1+1
.S TEXT(L1)=" ",L1=L1+1
S TEXT(L1)=" ",XMTEXT="TEXT("
S XMY(DUZ)="",XMY("G."_MGROUP)=""
;
; Additionally, send this MailMan message to the biller, the
; assigned to person, the person who last edited this bill, and
; the person who last sent it to ClaimsManager.
; esg - 9/5/01 & 9/27/01
;
S USER=+$$BILLER^IBCIUT5(IBIFN) I USER S XMY(USER)=""
S USER=+$P($G(^IBA(351.9,IBIFN,0)),U,12) I USER S XMY(USER)=""
S USER=+$P($G(^IBA(351.9,IBIFN,0)),U,9) I USER S XMY(USER)=""
S USER=+$P($G(^IBA(351.9,IBIFN,0)),U,5) I USER S XMY(USER)=""
;
S XMSUB="ClaimsManager Claim "_IBCICLNP_" Returned with Errors"
S XMDUZ="ClaimsManager Interface"
D ^XMD
Q
SNTMSG ;determine what user was doing for message
;
I IBCISNT=1 S IBCISMG="a Normal Send after Editing."
I IBCISNT=2 S IBCISMG="a Normal Send from the Multiple Send Option."
I IBCISNT=3 S IBCISMG="a Test Send from the Edit Screens."
I IBCISNT=4 S IBCISMG="to Cancel the Claim."
I IBCISNT=5 S IBCISMG="to Override the Errors."
I IBCISNT=6 S IBCISMG="to Send an Authorized Claim from the Multiple Send Option."
I IBCISNT=7 S IBCISMG="to delete the lines on this bill which is no longer a CMS-1500."
Q
;
;TCK CALL check text for ClaimsManager delimiters and strip if found
;Input variable
; x
TCK() ;check text for characters used as delimiters and strip them out
Q:$G(X)="" S X=$TR(X,$C(28,29,30)_"'%")
Q
CCK() ;check codes for decimal points and strip them out
Q:$G(X)="" S X=$TR(X,".")
Q
Z1AR ;converts ibciz array to ibciz1 array and import into error field
Q:'$D(IBCIZ) K IBCIZ1
S ERNUM=0 F S ERNUM=$O(IBCIZ("RL",ERNUM)) Q:'ERNUM D
.I $P(IBCIZ("RL",ERNUM,0),U,2)="" Q
.S IBCIZ1(ERNUM,0)=$P(IBCIZ("RL",ERNUM,0),U,2)_U_$P(IBCIZ("RL",ERNUM,0),U)_U_$P(IBCIZ("RL",ERNUM,0),U,3,999)
.S LINE=0 F S LINE=$O(IBCIZ("RL",ERNUM,"E",LINE)) Q:'LINE D
..S IBCIZ1(ERNUM,LINE)=IBCIZ("RL",ERNUM,"E",LINE)
I IBCISNT>2 G Z1Q
I $P($G(^IBA(351.9,IBIFN,1,0)),U,4) D DELER
S IBCIN1=0 F S IBCIN1=$O(IBCIZ1(IBCIN1)) Q:'IBCIN1 D ADDSUB1
Z1Q K DIC,DIE,DA,L1,LINE,ERDT,IBCIN1,ERNUM
Q
PROC() ;convert procedure code
Q:$G(X)="" N DA,GNODE
S DA=$P(X,";"),GNODE="^"_$P(X,";",2)_DA_",0)",X=$P(@GNODE,U)
Q
ADDSUB1 ;create the subfile for errors and add data
S DIC="^IBA(351.9,"_IBIFN_",1,",DA(1)=IBIFN,DIC(0)="LMN"
S X=$P(IBCIZ1(IBCIN1,0),U) D FILE^DICN Q:Y<1 S DA=+Y
S ERDT=$P(IBCIZ1(IBCIN1,0),U,2,999),ERDT=$TR(ERDT,"^","~")
S DIE=DIC,DR=".02////"_ERDT D ^DIE
S L1=0 F S L1=$O(IBCIZ1(IBCIN1,L1)) Q:'L1 D
.S IBCIZ1(IBCIN1,L1)=$TR(IBCIZ1(IBCIN1,L1),";",",")
.S DR=".03///+"_IBCIZ1(IBCIN1,L1) D ^DIE
Q
DELER ;delete the error information in 351.9
Q:'IBIFN
Q:'$P($G(^IBA(351.9,IBIFN,1,0)),U,4)
S DIK="^IBA(351.9,"_IBIFN_",1,",DA(1)=IBIFN
S DA=0 F S DA=$O(^IBA(351.9,IBIFN,1,DA)) Q:'DA D ^DIK
K DIK,DA
Q
DELTI ;delete temporary information in 351.9
N IBCIX4,TMPDATA,NODE
S DIE="^IBA(351.9,"_IBIFN_",5,"
F IBCIX4=$P($G(^IBA(351.9,IBIFN,5,0)),U,4):-1:1 S DA=IBCIX4 D
.S DA(1)=IBIFN,DR=".01////@" D ^DIE
K DIE,DR,DA
I $D(^IBA(351.9,IBIFN,4)) D
.S DIE="^IBA(351.9,",DA=IBIFN
.S DR="4.01////@;4.02////@;4.03////@;4.04////@" D ^DIE
K DIE,DR,DA
I $D(^IBA(351.9,IBIFN,3)) D
.S DIE="^IBA(351.9,",DA=IBIFN
.S DR="3.01////@;3.02////@;3.03////@;3.04////@;3.05////@;3.06////@;"
.S DR=DR_"3.07////@;3.08////@;3.09////@;3.1////@;3.11////@;3.12////@"
.D ^DIE K DIE,DR,DA
F NODE=3,4,5 S TMPDATA="^IBA(351.9,IBIFN,NODE)" K @TMPDATA
Q
;
DCOM(IBIFN) ;delete whatever's in the comment field in 351.9
S DIE="^IBA(351.9,",DA=IBIFN,DR="2.01///@;.13///@;.14///@"
D ^DIE K DIE,DA,DR
Q
;
P1(PROBLEM) ;comm error handling with problem variable
;Input variable
; PROBLEM
;Returns
; error code^error desc^msg returned from ClaimsManager
N IBCIY,IBCICODE,IBCIDESC,IBCIMSG S IBCICODE=PROBLEM
I IBCICODE=1 S IBCIDESC="TCP/IP time-out during 1st read." D
.S IBCIMSG=$G(IBCIZ)_" - "_$G(IBCIZ(1,1))
I IBCICODE=2 S IBCIDESC="Local Symbol Size Storage Problems during 1st read."
I IBCICODE=3 S IBCIDESC="1st read was NOT a ClaimsManager ACK message." D
.S IBCIMSG=$G(IBCIZ)_" - "_$G(IBCIZ(1,1))
I IBCICODE=4 S IBCIDESC="TCP/IP Time-out during 2nd read." D
.S IBCIMSG=$G(IBCIZ)_" - "_$G(IBCIZ(1,1))
I IBCICODE=5 S IBCIDESC="Local Symbol Size Storage Problems during 2nd read."
I IBCICODE=6 S IBCIDESC="2nd read was NOT a RESULTREC message type." D
.S IBCIMSG=$G(IBCIZ)_" - "_$G(IBCIZ(1,1))
I IBCICODE=7 S IBCIDESC="Fatal System Error",IBCIMSG=$G(IBCIZ)_" - "_$G(IBCIZ(1,1)) ; ib*226
I IBCICODE=99 S IBCIDESC="Unable to Open Port." D
.S IBCIMSG="Please restart the Ingenix Event Manager services."
I "^1^2^3^4^5^6^7^99^"'[IBCICODE S IBCIDESC="Unknown Error Type."
S IBCIY=IBCICODE_"^"_IBCIDESC_"^"_$G(IBCIMSG)
Q IBCIY
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCIUT4 7641 printed Oct 16, 2024@18:14:10 Page 2
IBCIUT4 ;DSI/SLM - MISC UTILITIES ;29-JAN-2001
+1 ;;2.0;INTEGRATED BILLING;**161,226,348**;21-MAR-94;Build 5
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 QUIT
COMERR ;create msg for comm error
+1 NEW L,L1,MGROUP,TEXT,IBCISMG,IBCIERR
+2 IF '$DATA(IBCICLNP)
SET IBCICLNP=$PIECE(^DGCR(399,IBIFN,0),U)
+3 SET MGROUP=$PIECE(^IBE(350.9,1,50),U,4)
SET MGROUP=$PIECE(^XMB(3.8,MGROUP,0),U)
SET L1=1
+4 SET IBCIERR=$$P1(PROBLEM)
+5 DO SNTMSG
+6 SET TEXT(L1)=" ** CLAIMSMANAGER COMMUNICATIONS ERROR **"
SET L1=L1+1
+7 SET TEXT(L1)=" "
SET L1=L1+1
+8 SET TEXT(L1)="While attempting to send claim # "_IBCICLNP_", Error Code # "_$PIECE(IBCIERR,U,1)
SET L1=L1+1
+9 SET TEXT(L1)="was generated."
SET L1=L1+1
+10 SET TEXT(L1)=" "
SET L1=L1+1
+11 SET TEXT(L1)="User attempted "_IBCISMG
SET L1=L1+1
+12 SET TEXT(L1)=" "
SET L1=L1+1
+13 SET TEXT(L1)="Error Description:"
SET L1=L1+1
+14 SET TEXT(L1)=" "
SET L1=L1+1
+15 SET TEXT(L1)=$PIECE(IBCIERR,U,2)
SET L1=L1+1
+16 SET TEXT(L1)=" "
SET L1=L1+1
+17 IF $PIECE(IBCIERR,U,3)'=""
Begin DoDot:1
+18 SET TEXT(L1)="ClaimsManager Error Message:"
SET L1=L1+1
+19 SET TEXT(L1)=" "
SET L1=L1+1
+20 SET TEXT(L1)=$PIECE($PIECE(IBCIERR,U,3)," - ",1)
SET L1=L1+1
+21 SET TEXT(L1)=$PIECE($PIECE(IBCIERR,U,3,99)," - ",2,99)
SET L1=L1+1
+22 SET TEXT(L1)=" "
SET L1=L1+1
+23 QUIT
End DoDot:1
+24 ;
+25 ; esg - 10/29/01 - Direct the reader to the Clear CM Results Queue
+26 ; option if the problem does not go away.
+27 ;
+28 IF PROBLEM=99
SET TEXT(L1)="Please correct the problem and send again."
SET L1=L1+1
+29 IF '$TEST
Begin DoDot:1
+30 SET TEXT(L1)="If this problem persists, then please try running the"
SET L1=L1+1
+31 SET TEXT(L1)="option to clear out the ClaimsManager results queue."
SET L1=L1+1
+32 SET TEXT(L1)="This option name is IBCI CLEAR CLAIMSMANAGER QUEUE."
SET L1=L1+1
+33 QUIT
End DoDot:1
+34 SET TEXT(L1)=" "
SET L1=L1+1
+35 SET TEXT(L1)="Bill Sent By: "_$PIECE(^VA(200,DUZ,0),U)
+36 SET XMSUB="ClaimsManager Communications Error sending "_IBCICLNP
+37 SET XMDUZ="ClaimsManager Interface"
SET XMTEXT="TEXT("
SET XMY("G."_MGROUP)=""
+38 DO ^XMD
+39 KILL XMSUB,XMDUZ,XMTEXT,TEXT
+40 QUIT
GENERR(IBIFN,IBCIETP) ;create msg for general error
+1 if IBCISNT'=2
QUIT
+2 NEW L,L1,L2,L3,MGROUP,TEXT,XMTEXT,XMY,XMSUB,XMDUZ,USER,IBCISMG,IBCIE1
+3 IF '$DATA(IBCICLNP)
SET IBCICLNP=$PIECE(^DGCR(399,IBIFN,0),U)
+4 SET MGROUP=$PIECE(^IBE(350.9,1,50),U,3)
SET MGROUP=$PIECE(^XMB(3.8,MGROUP,0),U)
SET L1=1
+5 DO SNTMSG
+6 SET TEXT(L1)="User attempted "_IBCISMG
SET L1=L1+1
+7 SET TEXT(L1)=" "
SET L1=L1+1
+8 ;pull error msg from 351.9 based on mnemonic (IBCIETP) error type
+9 SET IBCIE1=0
FOR
SET IBCIE1=$ORDER(^IBA(351.9,IBIFN,1,"B",IBCIETP,IBCIE1))
if 'IBCIE1
QUIT
Begin DoDot:1
+10 SET TEXT(L1)="Line Item: "_+$PIECE(^IBA(351.9,IBIFN,1,IBCIE1,0),U,2)
SET L1=L1+1
+11 SET TEXT(L1)="Error Mnemonic: "_$PIECE(^IBA(351.9,IBIFN,1,IBCIE1,0),U)
SET L1=L1+1
+12 SET TEXT(L1)="Error Level: "_$PIECE(^IBA(351.9,IBIFN,1,IBCIE1,0),"~",2)
SET L1=L1+1
+13 SET TEXT(L1)=" "
SET L1=L1+1
+14 SET TEXT(L1)="Error Message:"
SET L1=L1+1
+15 SET L2=0
FOR
SET L2=$ORDER(^IBA(351.9,IBIFN,1,IBCIE1,L2))
if 'L2
QUIT
Begin DoDot:2
+16 SET L3=0
FOR
SET L3=$ORDER(^IBA(351.9,IBIFN,1,IBCIE1,L2,L3))
if 'L3
QUIT
Begin DoDot:3
+17 SET TEXT(L1)=^IBA(351.9,IBIFN,1,IBCIE1,L2,L3,0)
SET L1=L1+1
End DoDot:3
End DoDot:2
+18 SET TEXT(L1)=" "
SET L1=L1+1
End DoDot:1
+19 SET TEXT(L1)=" "
SET XMTEXT="TEXT("
+20 SET XMY(DUZ)=""
SET XMY("G."_MGROUP)=""
+21 ;
+22 ; Additionally, send this MailMan message to the biller, the
+23 ; assigned to person, the person who last edited this bill, and
+24 ; the person who last sent it to ClaimsManager.
+25 ; esg - 9/5/01 & 9/27/01
+26 ;
+27 SET USER=+$$BILLER^IBCIUT5(IBIFN)
IF USER
SET XMY(USER)=""
+28 SET USER=+$PIECE($GET(^IBA(351.9,IBIFN,0)),U,12)
IF USER
SET XMY(USER)=""
+29 SET USER=+$PIECE($GET(^IBA(351.9,IBIFN,0)),U,9)
IF USER
SET XMY(USER)=""
+30 SET USER=+$PIECE($GET(^IBA(351.9,IBIFN,0)),U,5)
IF USER
SET XMY(USER)=""
+31 ;
+32 SET XMSUB="ClaimsManager Claim "_IBCICLNP_" Returned with Errors"
+33 SET XMDUZ="ClaimsManager Interface"
+34 DO ^XMD
+35 QUIT
SNTMSG ;determine what user was doing for message
+1 ;
+2 IF IBCISNT=1
SET IBCISMG="a Normal Send after Editing."
+3 IF IBCISNT=2
SET IBCISMG="a Normal Send from the Multiple Send Option."
+4 IF IBCISNT=3
SET IBCISMG="a Test Send from the Edit Screens."
+5 IF IBCISNT=4
SET IBCISMG="to Cancel the Claim."
+6 IF IBCISNT=5
SET IBCISMG="to Override the Errors."
+7 IF IBCISNT=6
SET IBCISMG="to Send an Authorized Claim from the Multiple Send Option."
+8 IF IBCISNT=7
SET IBCISMG="to delete the lines on this bill which is no longer a CMS-1500."
+9 QUIT
+10 ;
+11 ;TCK CALL check text for ClaimsManager delimiters and strip if found
+12 ;Input variable
+13 ; x
TCK() ;check text for characters used as delimiters and strip them out
+1 if $GET(X)=""
QUIT
SET X=$TRANSLATE(X,$CHAR(28,29,30)_"'%")
+2 QUIT
CCK() ;check codes for decimal points and strip them out
+1 if $GET(X)=""
QUIT
SET X=$TRANSLATE(X,".")
+2 QUIT
Z1AR ;converts ibciz array to ibciz1 array and import into error field
+1 if '$DATA(IBCIZ)
QUIT
KILL IBCIZ1
+2 SET ERNUM=0
FOR
SET ERNUM=$ORDER(IBCIZ("RL",ERNUM))
if 'ERNUM
QUIT
Begin DoDot:1
+3 IF $PIECE(IBCIZ("RL",ERNUM,0),U,2)=""
QUIT
+4 SET IBCIZ1(ERNUM,0)=$PIECE(IBCIZ("RL",ERNUM,0),U,2)_U_$PIECE(IBCIZ("RL",ERNUM,0),U)_U_$PIECE(IBCIZ("RL",ERNUM,0),U,3,999)
+5 SET LINE=0
FOR
SET LINE=$ORDER(IBCIZ("RL",ERNUM,"E",LINE))
if 'LINE
QUIT
Begin DoDot:2
+6 SET IBCIZ1(ERNUM,LINE)=IBCIZ("RL",ERNUM,"E",LINE)
End DoDot:2
End DoDot:1
+7 IF IBCISNT>2
GOTO Z1Q
+8 IF $PIECE($GET(^IBA(351.9,IBIFN,1,0)),U,4)
DO DELER
+9 SET IBCIN1=0
FOR
SET IBCIN1=$ORDER(IBCIZ1(IBCIN1))
if 'IBCIN1
QUIT
DO ADDSUB1
Z1Q KILL DIC,DIE,DA,L1,LINE,ERDT,IBCIN1,ERNUM
+1 QUIT
PROC() ;convert procedure code
+1 if $GET(X)=""
QUIT
NEW DA,GNODE
+2 SET DA=$PIECE(X,";")
SET GNODE="^"_$PIECE(X,";",2)_DA_",0)"
SET X=$PIECE(@GNODE,U)
+3 QUIT
ADDSUB1 ;create the subfile for errors and add data
+1 SET DIC="^IBA(351.9,"_IBIFN_",1,"
SET DA(1)=IBIFN
SET DIC(0)="LMN"
+2 SET X=$PIECE(IBCIZ1(IBCIN1,0),U)
DO FILE^DICN
if Y<1
QUIT
SET DA=+Y
+3 SET ERDT=$PIECE(IBCIZ1(IBCIN1,0),U,2,999)
SET ERDT=$TRANSLATE(ERDT,"^","~")
+4 SET DIE=DIC
SET DR=".02////"_ERDT
DO ^DIE
+5 SET L1=0
FOR
SET L1=$ORDER(IBCIZ1(IBCIN1,L1))
if 'L1
QUIT
Begin DoDot:1
+6 SET IBCIZ1(IBCIN1,L1)=$TRANSLATE(IBCIZ1(IBCIN1,L1),";",",")
+7 SET DR=".03///+"_IBCIZ1(IBCIN1,L1)
DO ^DIE
End DoDot:1
+8 QUIT
DELER ;delete the error information in 351.9
+1 if 'IBIFN
QUIT
+2 if '$PIECE($GET(^IBA(351.9,IBIFN,1,0)),U,4)
QUIT
+3 SET DIK="^IBA(351.9,"_IBIFN_",1,"
SET DA(1)=IBIFN
+4 SET DA=0
FOR
SET DA=$ORDER(^IBA(351.9,IBIFN,1,DA))
if 'DA
QUIT
DO ^DIK
+5 KILL DIK,DA
+6 QUIT
DELTI ;delete temporary information in 351.9
+1 NEW IBCIX4,TMPDATA,NODE
+2 SET DIE="^IBA(351.9,"_IBIFN_",5,"
+3 FOR IBCIX4=$PIECE($GET(^IBA(351.9,IBIFN,5,0)),U,4):-1:1
SET DA=IBCIX4
Begin DoDot:1
+4 SET DA(1)=IBIFN
SET DR=".01////@"
DO ^DIE
End DoDot:1
+5 KILL DIE,DR,DA
+6 IF $DATA(^IBA(351.9,IBIFN,4))
Begin DoDot:1
+7 SET DIE="^IBA(351.9,"
SET DA=IBIFN
+8 SET DR="4.01////@;4.02////@;4.03////@;4.04////@"
DO ^DIE
End DoDot:1
+9 KILL DIE,DR,DA
+10 IF $DATA(^IBA(351.9,IBIFN,3))
Begin DoDot:1
+11 SET DIE="^IBA(351.9,"
SET DA=IBIFN
+12 SET DR="3.01////@;3.02////@;3.03////@;3.04////@;3.05////@;3.06////@;"
+13 SET DR=DR_"3.07////@;3.08////@;3.09////@;3.1////@;3.11////@;3.12////@"
+14 DO ^DIE
KILL DIE,DR,DA
End DoDot:1
+15 FOR NODE=3,4,5
SET TMPDATA="^IBA(351.9,IBIFN,NODE)"
KILL @TMPDATA
+16 QUIT
+17 ;
DCOM(IBIFN) ;delete whatever's in the comment field in 351.9
+1 SET DIE="^IBA(351.9,"
SET DA=IBIFN
SET DR="2.01///@;.13///@;.14///@"
+2 DO ^DIE
KILL DIE,DA,DR
+3 QUIT
+4 ;
P1(PROBLEM) ;comm error handling with problem variable
+1 ;Input variable
+2 ; PROBLEM
+3 ;Returns
+4 ; error code^error desc^msg returned from ClaimsManager
+5 NEW IBCIY,IBCICODE,IBCIDESC,IBCIMSG
SET IBCICODE=PROBLEM
+6 IF IBCICODE=1
SET IBCIDESC="TCP/IP time-out during 1st read."
Begin DoDot:1
+7 SET IBCIMSG=$GET(IBCIZ)_" - "_$GET(IBCIZ(1,1))
End DoDot:1
+8 IF IBCICODE=2
SET IBCIDESC="Local Symbol Size Storage Problems during 1st read."
+9 IF IBCICODE=3
SET IBCIDESC="1st read was NOT a ClaimsManager ACK message."
Begin DoDot:1
+10 SET IBCIMSG=$GET(IBCIZ)_" - "_$GET(IBCIZ(1,1))
End DoDot:1
+11 IF IBCICODE=4
SET IBCIDESC="TCP/IP Time-out during 2nd read."
Begin DoDot:1
+12 SET IBCIMSG=$GET(IBCIZ)_" - "_$GET(IBCIZ(1,1))
End DoDot:1
+13 IF IBCICODE=5
SET IBCIDESC="Local Symbol Size Storage Problems during 2nd read."
+14 IF IBCICODE=6
SET IBCIDESC="2nd read was NOT a RESULTREC message type."
Begin DoDot:1
+15 SET IBCIMSG=$GET(IBCIZ)_" - "_$GET(IBCIZ(1,1))
End DoDot:1
+16 ; ib*226
IF IBCICODE=7
SET IBCIDESC="Fatal System Error"
SET IBCIMSG=$GET(IBCIZ)_" - "_$GET(IBCIZ(1,1))
+17 IF IBCICODE=99
SET IBCIDESC="Unable to Open Port."
Begin DoDot:1
+18 SET IBCIMSG="Please restart the Ingenix Event Manager services."
End DoDot:1
+19 IF "^1^2^3^4^5^6^7^99^"'[IBCICODE
SET IBCIDESC="Unknown Error Type."
+20 SET IBCIY=IBCICODE_"^"_IBCIDESC_"^"_$GET(IBCIMSG)
+21 QUIT IBCIY
+22 ;
