- IBCE837I ;EDE/JWS - OUTPUT FOR 837 FHIR TRANSMISSION ;5/23/18 10:48am
- ;;2.0;INTEGRATED BILLING;**623,641,650,665,742**;23-MAY-18;Build 36
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- RES(RES) ;Set resource name correctly
- ;
- ; Get Resource requested, '*' if all resources
- I RES="*" Q RES
- ;S RES=$$TITLE^XLFSTR($G(ARG("RES")))
- I RES="Valueset" S RES="ValueSet" G Q
- I RES="Explanationofbenefit" S RES="ExplanationOfBenefit" G Q
- I RES="Imagingstudy" S RES="ImagingStudy" G Q
- I RES="Careplan" S RES="CarePlan" G Q
- I RES="Episodeofcare" S RES="EpisodeOfCare" G Q
- I RES="Documentmanifest" S RES="DocumentManifest" G Q
- I RES="Claimresponse" S RES="ClaimResponse" G Q
- I RES="Eligibilityrequest" S RES="EligibilityRequest" G Q
- I RES="Chargeitem" S RES="ChargeItem" G Q
- I RES="Procedurerequest" S RES="ProcedureRequest" G Q
- I RES="Healthcareservice" S RES="HealthcareService" G Q
- I RES="Relatedperson" S RES="RelatedPerson" G Q
- I RES="Paymentnotice" S RES="PaymentNotice" G Q
- I RES="Medicationrequest" S RES="MedicationRequest" G Q
- I RES="Medicationdispense" S RES="MedicationDispense" G Q
- I RES="Practitionerrole" S RES="PractitionerRole" G Q
- I RES="Supplyrequest" S RES="SupplyRequest"
- Q ;
- Q RES
- ;
- FINISH ; enclose message in '[ ]' when a Bundle
- N X
- I $G(RESULT(1))=""!($G(RESULT(1))="{}") S RESULT(1)="[{}]" Q
- I $G(RES)="*" D
- . S RESULT(1)="{""Bundle"":["_RESULT(1)
- . S X=$O(RESULT("A"),-1)
- . S RESULT(X)=RESULT(X)_"]}"
- S RESULT(1)="["_RESULT(1)
- S X=$O(RESULT("A"),-1)
- S RESULT(X)=RESULT(X)_"]"
- Q
- ;
- END ; enclose message in '[ ]'
- N X
- I $G(RESULT(1))="" S RESULT(1)="{}"
- S RESULT(1)="["_$G(RESULT(1))_"]"
- Q
- ;
- GET(RESULT,ARG) ;RPC - EDICLAIMS; get list of claims to transmit
- ;
- ;D APPERROR^%ZTER("RPC USER") ; WCJ TEMP LINE TO SEE SOME VARIABLES
- N CT,DUZ,IBGBL,IBX,IBTEST,IBXIEN,IB0,IBTXST,IBTXTEST,IBBTYP,IBDIV,IB837R,IBNF,IBNOTX,MCNT
- K ^TMP($J,"BILL"),^TMP($J,"FHIR837")
- ;JWS;IB*2.0*650v7;3/16/21;remove setting of DUZ(0)
- D DTNOLF^DICRW
- S IBGBL="^IBA(364,""AC"",1)",CT=1
- ;JWS;IB*2.0*641v8;added MCNT for maximum count of claims IENs, >20,000 breaks FHIR
- S IBX="" F S IBX=$O(@IBGBL@(IBX)) Q:'IBX D I $G(MCNT)>19999 Q
- . S IBTEST=$$GET1^DIQ(364,IBX_",",.07,"I")
- . S IBXIEN=+$G(^IBA(364,IBX,0)),IBNF=""
- . ;JWS;IB*2.0*665v17;EBILL-2241;11/2/21;found at Miami; again at Miami 12/3/21 (similar at Tongus, Orlando, West Palm) - bad entry in 364 file
- . I IBXIEN=0 D REMCLM1(IBX) Q
- . S IB0=$G(^DGCR(399,IBXIEN,0))
- . S IBTXST=$$TXMT^IBCEF4(IBXIEN,.IBNOTX,IBNF)
- . ;JWS;IB*2.0*623v25;if claim is invalid to send, remove from 'AC' index
- . I IBTXST="" D REMCLM(IBX) Q ; no txmt
- . I IB0="" D REMCLM(IBX) Q
- . I $P(IB0,U,13)>4,'IBTEST D REMCLM(IBX) Q
- . I $F($P(IB0,U),"-") D REMCLM(IBX) Q
- . ;JWS;end IB*2.0*623v25;
- . S IBTXTEST=$S(IBTEST:2,1:+$$TEST^IBCEF4(IBXIEN))
- . S IBBTYP=$P("P^I^D",U,$S($$FT^IBCEF(IBXIEN)=7:3,1:($$FT^IBCEF(IBXIEN)=3)+1))_"-"_IBTXTEST
- . ;JWS;IB*2.0*623v25;if not sending, remove from queue
- . I $$TESTPT^IBCEU($P(IB0,U,2)),'IBTXTEST D REMCLM(IBX) Q
- . ;JWS;IB*2.0*623v25;if not sending, remove from queue
- . I $D(^TMP($J,"BILL",$P(IB0,U))) D REMCLM(IBX) Q ; do not send duplicates
- . ;JWS;IB*2.0*641v8;added MCNT for maximum count of claims IENs, >20,000 breaks FHIR
- . S ^TMP($J,"BILL",$P(IB0,U))="",MCNT=$G(MCNT)+1
- . S IBDIV=$P($S($P(IB0,U,22):$$SITE^VASITE(DT,$P(IB0,U,22)),1:$$SITE^VASITE()),U,3)
- . S IB837R=$$RECVR^IBCEF2(IBXIEN)
- . I $L($G(RESULT(CT)))>3000 S RESULT(CT)=RESULT(CT)_",",CT=$G(CT)+1
- . ;;I IBDIV=442 S IBDIV=681 ; for eBilling_dev environment
- . S RESULT(CT)=$S($G(RESULT(CT))'="":RESULT(CT)_",",1:"")_"{""ien"":"""_IBXIEN_""",""site"":"""_IBDIV_""",""type"":"""_IB837R_""",""status"":"""_$S(IBTXTEST=0:"live",1:"test")_"""}"
- . Q
- D FINISH
- Q
- ;
- TESTING ;
- ;K (ARG,U)
- N I,RESOURCE
- S ARG("IEN399")=2113336 ; 2113336 - PROF ;2113173 - Dental (1 line) ;2113182 - dental ;211334 - INST
- R !,"Resource Requested: ",RESOURCE:30 Q:RESOURCE=""
- S ARG("RES")=RESOURCE ;"Basic" or "*"
- D GET^IBCE837H(.RESULT,.ARG)
- F I=1:1 Q:'$D(RESULT(I)) W:I=1 ! W RESULT(I)
- Q
- ;
- REC(REC) ;check to see which records are repeating
- I $F(",63,104.8,104.91,105,107,110,112,113,114,115,120,125,130,135,170,170.5,171,172,173,176,177,178,178.1,180,",","_REC_",") Q 1
- I REC>180 Q 1
- Q 0
- ;
- SETD ; update ^TMP global
- S DONE=1
- D UP
- ;S @DATA1@(CT,":")=DATA_FILE_"-"_FLD_"-"_NAME_"("_X1_")""" ; includes record # for testing
- ;JWS;6/20/23;EBILL-3508;IB*2.0*742v13;issue with multiple record counter and workaround record deletions. Use IBRECCT(XREC) instead of X2 variable
- S @DATA1@(CT,":")=DATA_FILE_"-"_FLD_$S($$REC(X1):"."_$G(IBRECCT(XREC)),1:"")_"-"_NAME_""""
- D UP
- S @DATA1@(CT,":")="""value"":"""_TASDATA_"""}"
- Q
- ;
- UP ;increment CT
- S CT=$G(CT)+1
- Q
- ;
- SETCLM(IBIEN,IBQ,RSUB) ; set the FHIR 837 claim for submission
- N DA,D0,DR,DIE,DIC
- S DA=IBIEN I DA="" Q
- ;JWS;IB*2.0*665v17;EBILL-2241;11/2/21;found at Miami; again at Miami 12/3/21 (similar at Tongus, Orlando, West Palm) - bad entry in 364 file
- I $P($G(^IBA(364,DA,0)),"^")="" Q
- I '$$PROD^XUPROD(1) S IBQ="MCT" ; if on a non-production server, send to test queue.
- ;JWS;IB*2.0*623v24;added field .10 to 364 file entry if a resubmission
- S DR=".09////1"_$S(IBQ="MCT":";.07////1",1:";.07////0")_$S($G(RSUB)=1:";.1////1",1:""),DIE="^IBA(364,"
- D ^DIE
- Q
- ;JWS;IB*2.0*623v24
- ;JWS;IB*2.0*650v5 - add set/clear of field .11, file 364 FHIR Bundle Validation flag [11]
- SETSUB(IBIEN,IBVAL,IBFLD) ; clear the resubmission flag
- N DA,D0,DR,DIE,DIC
- S DA=IBIEN I DA="" Q
- I $G(IBFLD)=".11" S DR=".11////"_IBVAL
- E S DR=".1////"_IBVAL
- S DIE="^IBA(364,"
- D ^DIE
- Q
- ;
- TEST(IBIEN364) ; return test flag
- N IBTEST,IBXIEN,IBTXTEST
- S IBTEST=$$GET1^DIQ(364,IBIEN364_",",.07,"I")
- S IBXIEN=+$G(^IBA(364,IBIEN364,0)),IBNF=""
- ;JWS;IB*2.0*623v24;7/19/19 - make sure non-prod claims are sent to test queue
- S IBTXTEST=$S(IBTEST:2,'$$PROD^XUPROD(1):1,1:+$$TEST^IBCEF4(IBXIEN))
- ;S IBTXTEST=$S(IBTEST:2,1:+$$TEST^IBCEF4(IBXIEN))
- Q $S(IBTXTEST=0:0,1:1)
- ;
- ;JWS;IB*2.0*623;v25
- REMCLM(IB364) ; clear the FHIR 837 claim for submission
- N DA,D0,DR,DIE,DIC
- S DA=IB364 I DA="" Q
- S DR=".03////Z;.09////2",DIE="^IBA(364,"
- D ^DIE
- Q
- ;
- REMCLM1(IB364) ;;JWS;IB*2.0*665v17;EBILL-2241;11/2/21;found at Miami; again at Miami 12/3/21 (similar at Tongus, Orlando, West Palm) - bad entry in 364 file
- ;remove bad 364 entry
- N DA,D0,DR,DIE,DIC,DIK
- I +IB364=0 Q
- S DA=IB364
- S DIK="^IBA(364," D ^DIK
- Q
- ;
- ;JWS;IB*2.0*641v13
- TEST608(IBIEN364) ;return claim test flag;flag only for conditional inclusion of COB info on claim data
- N IBTEST,IBXIEN,IBTXTEST
- S IBTEST=$$GET1^DIQ(364,IBIEN364_",",.07,"I")
- S IBXIEN=+$G(^IBA(364,IBIEN364,0)),IBNF=""
- S IBTXTEST=$S(IBTEST:2,1:+$$TEST^IBCEF4(IBXIEN))
- Q $S(IBTXTEST=0:0,1:1)
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCE837I 6916 printed Feb 18, 2025@23:35:53 Page 2
- IBCE837I ;EDE/JWS - OUTPUT FOR 837 FHIR TRANSMISSION ;5/23/18 10:48am
- +1 ;;2.0;INTEGRATED BILLING;**623,641,650,665,742**;23-MAY-18;Build 36
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- RES(RES) ;Set resource name correctly
- +1 ;
- +2 ; Get Resource requested, '*' if all resources
- +3 IF RES="*"
- QUIT RES
- +4 ;S RES=$$TITLE^XLFSTR($G(ARG("RES")))
- +5 IF RES="Valueset"
- SET RES="ValueSet"
- GOTO Q
- +6 IF RES="Explanationofbenefit"
- SET RES="ExplanationOfBenefit"
- GOTO Q
- +7 IF RES="Imagingstudy"
- SET RES="ImagingStudy"
- GOTO Q
- +8 IF RES="Careplan"
- SET RES="CarePlan"
- GOTO Q
- +9 IF RES="Episodeofcare"
- SET RES="EpisodeOfCare"
- GOTO Q
- +10 IF RES="Documentmanifest"
- SET RES="DocumentManifest"
- GOTO Q
- +11 IF RES="Claimresponse"
- SET RES="ClaimResponse"
- GOTO Q
- +12 IF RES="Eligibilityrequest"
- SET RES="EligibilityRequest"
- GOTO Q
- +13 IF RES="Chargeitem"
- SET RES="ChargeItem"
- GOTO Q
- +14 IF RES="Procedurerequest"
- SET RES="ProcedureRequest"
- GOTO Q
- +15 IF RES="Healthcareservice"
- SET RES="HealthcareService"
- GOTO Q
- +16 IF RES="Relatedperson"
- SET RES="RelatedPerson"
- GOTO Q
- +17 IF RES="Paymentnotice"
- SET RES="PaymentNotice"
- GOTO Q
- +18 IF RES="Medicationrequest"
- SET RES="MedicationRequest"
- GOTO Q
- +19 IF RES="Medicationdispense"
- SET RES="MedicationDispense"
- GOTO Q
- +20 IF RES="Practitionerrole"
- SET RES="PractitionerRole"
- GOTO Q
- +21 IF RES="Supplyrequest"
- SET RES="SupplyRequest"
- Q ;
- +1 QUIT RES
- +2 ;
- FINISH ; enclose message in '[ ]' when a Bundle
- +1 NEW X
- +2 IF $GET(RESULT(1))=""!($GET(RESULT(1))="{}")
- SET RESULT(1)="[{}]"
- QUIT
- +3 IF $GET(RES)="*"
- Begin DoDot:1
- +4 SET RESULT(1)="{""Bundle"":["_RESULT(1)
- +5 SET X=$ORDER(RESULT("A"),-1)
- +6 SET RESULT(X)=RESULT(X)_"]}"
- End DoDot:1
- +7 SET RESULT(1)="["_RESULT(1)
- +8 SET X=$ORDER(RESULT("A"),-1)
- +9 SET RESULT(X)=RESULT(X)_"]"
- +10 QUIT
- +11 ;
- END ; enclose message in '[ ]'
- +1 NEW X
- +2 IF $GET(RESULT(1))=""
- SET RESULT(1)="{}"
- +3 SET RESULT(1)="["_$GET(RESULT(1))_"]"
- +4 QUIT
- +5 ;
- GET(RESULT,ARG) ;RPC - EDICLAIMS; get list of claims to transmit
- +1 ;
- +2 ;D APPERROR^%ZTER("RPC USER") ; WCJ TEMP LINE TO SEE SOME VARIABLES
- +3 NEW CT,DUZ,IBGBL,IBX,IBTEST,IBXIEN,IB0,IBTXST,IBTXTEST,IBBTYP,IBDIV,IB837R,IBNF,IBNOTX,MCNT
- +4 KILL ^TMP($JOB,"BILL"),^TMP($JOB,"FHIR837")
- +5 ;JWS;IB*2.0*650v7;3/16/21;remove setting of DUZ(0)
- +6 DO DTNOLF^DICRW
- +7 SET IBGBL="^IBA(364,""AC"",1)"
- SET CT=1
- +8 ;JWS;IB*2.0*641v8;added MCNT for maximum count of claims IENs, >20,000 breaks FHIR
- +9 SET IBX=""
- FOR
- SET IBX=$ORDER(@IBGBL@(IBX))
- if 'IBX
- QUIT
- Begin DoDot:1
- +10 SET IBTEST=$$GET1^DIQ(364,IBX_",",.07,"I")
- +11 SET IBXIEN=+$GET(^IBA(364,IBX,0))
- SET IBNF=""
- +12 ;JWS;IB*2.0*665v17;EBILL-2241;11/2/21;found at Miami; again at Miami 12/3/21 (similar at Tongus, Orlando, West Palm) - bad entry in 364 file
- +13 IF IBXIEN=0
- DO REMCLM1(IBX)
- QUIT
- +14 SET IB0=$GET(^DGCR(399,IBXIEN,0))
- +15 SET IBTXST=$$TXMT^IBCEF4(IBXIEN,.IBNOTX,IBNF)
- +16 ;JWS;IB*2.0*623v25;if claim is invalid to send, remove from 'AC' index
- +17 ; no txmt
- IF IBTXST=""
- DO REMCLM(IBX)
- QUIT
- +18 IF IB0=""
- DO REMCLM(IBX)
- QUIT
- +19 IF $PIECE(IB0,U,13)>4
- IF 'IBTEST
- DO REMCLM(IBX)
- QUIT
- +20 IF $FIND($PIECE(IB0,U),"-")
- DO REMCLM(IBX)
- QUIT
- +21 ;JWS;end IB*2.0*623v25;
- +22 SET IBTXTEST=$SELECT(IBTEST:2,1:+$$TEST^IBCEF4(IBXIEN))
- +23 SET IBBTYP=$PIECE("P^I^D",U,$SELECT($$FT^IBCEF(IBXIEN)=7:3,1:($$FT^IBCEF(IBXIEN)=3)+1))_"-"_IBTXTEST
- +24 ;JWS;IB*2.0*623v25;if not sending, remove from queue
- +25 IF $$TESTPT^IBCEU($PIECE(IB0,U,2))
- IF 'IBTXTEST
- DO REMCLM(IBX)
- QUIT
- +26 ;JWS;IB*2.0*623v25;if not sending, remove from queue
- +27 ; do not send duplicates
- IF $DATA(^TMP($JOB,"BILL",$PIECE(IB0,U)))
- DO REMCLM(IBX)
- QUIT
- +28 ;JWS;IB*2.0*641v8;added MCNT for maximum count of claims IENs, >20,000 breaks FHIR
- +29 SET ^TMP($JOB,"BILL",$PIECE(IB0,U))=""
- SET MCNT=$GET(MCNT)+1
- +30 SET IBDIV=$PIECE($SELECT($PIECE(IB0,U,22):$$SITE^VASITE(DT,$PIECE(IB0,U,22)),1:$$SITE^VASITE()),U,3)
- +31 SET IB837R=$$RECVR^IBCEF2(IBXIEN)
- +32 IF $LENGTH($GET(RESULT(CT)))>3000
- SET RESULT(CT)=RESULT(CT)_","
- SET CT=$GET(CT)+1
- +33 ;;I IBDIV=442 S IBDIV=681 ; for eBilling_dev environment
- +34 SET RESULT(CT)=$SELECT($GET(RESULT(CT))'="":RESULT(CT)_",",1:"")_"{""ien"":"""_IBXIEN_""",""site"":"""_IBDIV_""",""type"":"""_IB837R_""",""status"":"""_$SELECT(IBTXTEST=0:"live",1:"test")_"""}"
- +35 QUIT
- End DoDot:1
- IF $GET(MCNT)>19999
- QUIT
- +36 DO FINISH
- +37 QUIT
- +38 ;
- TESTING ;
- +1 ;K (ARG,U)
- +2 NEW I,RESOURCE
- +3 ; 2113336 - PROF ;2113173 - Dental (1 line) ;2113182 - dental ;211334 - INST
- SET ARG("IEN399")=2113336
- +4 READ !,"Resource Requested: ",RESOURCE:30
- if RESOURCE=""
- QUIT
- +5 ;"Basic" or "*"
- SET ARG("RES")=RESOURCE
- +6 DO GET^IBCE837H(.RESULT,.ARG)
- +7 FOR I=1:1
- if '$DATA(RESULT(I))
- QUIT
- if I=1
- WRITE !
- WRITE RESULT(I)
- +8 QUIT
- +9 ;
- REC(REC) ;check to see which records are repeating
- +1 IF $FIND(",63,104.8,104.91,105,107,110,112,113,114,115,120,125,130,135,170,170.5,171,172,173,176,177,178,178.1,180,",","_REC_",")
- QUIT 1
- +2 IF REC>180
- QUIT 1
- +3 QUIT 0
- +4 ;
- SETD ; update ^TMP global
- +1 SET DONE=1
- +2 DO UP
- +3 ;S @DATA1@(CT,":")=DATA_FILE_"-"_FLD_"-"_NAME_"("_X1_")""" ; includes record # for testing
- +4 ;JWS;6/20/23;EBILL-3508;IB*2.0*742v13;issue with multiple record counter and workaround record deletions. Use IBRECCT(XREC) instead of X2 variable
- +5 SET @DATA1@(CT,":")=DATA_FILE_"-"_FLD_$SELECT($$REC(X1):"."_$GET(IBRECCT(XREC)),1:"")_"-"_NAME_""""
- +6 DO UP
- +7 SET @DATA1@(CT,":")="""value"":"""_TASDATA_"""}"
- +8 QUIT
- +9 ;
- UP ;increment CT
- +1 SET CT=$GET(CT)+1
- +2 QUIT
- +3 ;
- SETCLM(IBIEN,IBQ,RSUB) ; set the FHIR 837 claim for submission
- +1 NEW DA,D0,DR,DIE,DIC
- +2 SET DA=IBIEN
- IF DA=""
- QUIT
- +3 ;JWS;IB*2.0*665v17;EBILL-2241;11/2/21;found at Miami; again at Miami 12/3/21 (similar at Tongus, Orlando, West Palm) - bad entry in 364 file
- +4 IF $PIECE($GET(^IBA(364,DA,0)),"^")=""
- QUIT
- +5 ; if on a non-production server, send to test queue.
- IF '$$PROD^XUPROD(1)
- SET IBQ="MCT"
- +6 ;JWS;IB*2.0*623v24;added field .10 to 364 file entry if a resubmission
- +7 SET DR=".09////1"_$SELECT(IBQ="MCT":";.07////1",1:";.07////0")_$SELECT($GET(RSUB)=1:";.1////1",1:"")
- SET DIE="^IBA(364,"
- +8 DO ^DIE
- +9 QUIT
- +10 ;JWS;IB*2.0*623v24
- +11 ;JWS;IB*2.0*650v5 - add set/clear of field .11, file 364 FHIR Bundle Validation flag [11]
- SETSUB(IBIEN,IBVAL,IBFLD) ; clear the resubmission flag
- +1 NEW DA,D0,DR,DIE,DIC
- +2 SET DA=IBIEN
- IF DA=""
- QUIT
- +3 IF $GET(IBFLD)=".11"
- SET DR=".11////"_IBVAL
- +4 IF '$TEST
- SET DR=".1////"_IBVAL
- +5 SET DIE="^IBA(364,"
- +6 DO ^DIE
- +7 QUIT
- +8 ;
- TEST(IBIEN364) ; return test flag
- +1 NEW IBTEST,IBXIEN,IBTXTEST
- +2 SET IBTEST=$$GET1^DIQ(364,IBIEN364_",",.07,"I")
- +3 SET IBXIEN=+$GET(^IBA(364,IBIEN364,0))
- SET IBNF=""
- +4 ;JWS;IB*2.0*623v24;7/19/19 - make sure non-prod claims are sent to test queue
- +5 SET IBTXTEST=$SELECT(IBTEST:2,'$$PROD^XUPROD(1):1,1:+$$TEST^IBCEF4(IBXIEN))
- +6 ;S IBTXTEST=$S(IBTEST:2,1:+$$TEST^IBCEF4(IBXIEN))
- +7 QUIT $SELECT(IBTXTEST=0:0,1:1)
- +8 ;
- +9 ;JWS;IB*2.0*623;v25
- REMCLM(IB364) ; clear the FHIR 837 claim for submission
- +1 NEW DA,D0,DR,DIE,DIC
- +2 SET DA=IB364
- IF DA=""
- QUIT
- +3 SET DR=".03////Z;.09////2"
- SET DIE="^IBA(364,"
- +4 DO ^DIE
- +5 QUIT
- +6 ;
- REMCLM1(IB364) ;;JWS;IB*2.0*665v17;EBILL-2241;11/2/21;found at Miami; again at Miami 12/3/21 (similar at Tongus, Orlando, West Palm) - bad entry in 364 file
- +1 ;remove bad 364 entry
- +2 NEW DA,D0,DR,DIE,DIC,DIK
- +3 IF +IB364=0
- QUIT
- +4 SET DA=IB364
- +5 SET DIK="^IBA(364,"
- DO ^DIK
- +6 QUIT
- +7 ;
- +8 ;JWS;IB*2.0*641v13
- TEST608(IBIEN364) ;return claim test flag;flag only for conditional inclusion of COB info on claim data
- +1 NEW IBTEST,IBXIEN,IBTXTEST
- +2 SET IBTEST=$$GET1^DIQ(364,IBIEN364_",",.07,"I")
- +3 SET IBXIEN=+$GET(^IBA(364,IBIEN364,0))
- SET IBNF=""
- +4 SET IBTXTEST=$SELECT(IBTEST:2,1:+$$TEST^IBCEF4(IBXIEN))
- +5 QUIT $SELECT(IBTXTEST=0:0,1:1)
- +6 ;