- 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 Feb 18, 2025@23:39:53 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 ;