IBCNEUT2 ;DAOU/DAC - eIV MISC. UTILITIES ;06-JUN-2002
;;2.0;INTEGRATED BILLING;**184,416,435,713,737**;21-MAR-94;Build 19
;;Per VA Directive 6402, this routine should not be modified.
;
; Can't be called from the top
Q
;
SAVETQ(IEN,TDT) ; Update service date in TQ record
;
N DIE,DA,DR,D,D0,DI,DIC,DQ,X
S DIE="^IBCN(365.1,",DA=IEN,DR=".12////"_TDT
D ^DIE
Q
;
;
SST(IEN,STAT) ; Set the Transmission Queue Status
; Input parameters
; IEN = Internal entry number for the record
; STAT= Status IEN
;
NEW DIE,DA,DR,D,D0,DI,DIC,DQ,X
;
I IEN="" Q
;
S DIE="^IBCN(365.1,",DA=IEN,DR=".04////^S X=STAT;.15////^S X=$$NOW^XLFDT()"
D ^DIE
Q
;
RSP(IEN,STAT) ; Set the Response File Status
; Input parameters
; IEN = Internal entry number for the record
; STAT= Status IEN
;
NEW DIE,DA,DR,D,D0,DI,DIC,DQ,X
S DIE="^IBCN(365,",DA=IEN,DR=".06////^S X=STAT"
D ^DIE
Q
;
BUFF(BUFF,BNG) ; Set error symbol into Buffer File
; Input Parameter
; BUFF = Buffer internal entry number
; BNG = Buffer Symbol IEN
I 'BUFF!'BNG Q
I +$P($G(^IBA(355.33,BUFF,0)),U,17) Q ; .12 field not for ePharmacy IB*2*435
NEW DIE,DA,DR,D,D0,DI,DIC,DQ,X,DISYS
S DIE="^IBA(355.33,",DA=BUFF,DR=".12////^S X=BNG"
D ^DIE
Q
;
BADMSG(EXT,QUERY) ; Checks to see if the msg is allowed
; IB*713 Introduced this tag, checks for foreign characters as defined
; in FOREIGN^IBCNINSU. If foreign characters are encountered, some
; times the msg can't be created/sent via HL7. Other times, if you
; clear out the field with the foreign character you can still send
; the message. (Watch for the STOP variable.)
; This could be expanded in the future to check other scenarios that
; should stop the transmissions.
;
;INPUT:
; EXT = WHICH EXTRACT (#365.1,.1)
; QUERY = QUERY FLAG(#365.1,.11)
; PID, IN1, HLFS, HLECH - existing global variables
; GT1 global variable that may or may not exist
;
;OUTPUT: 0 - Continue with creating and sending HL7 msg
; 1 - Do not send this TQ entry out as a HL7 msg
; * NOTE: If Abort, this function sets the
; TRANSMISSION QUEUE (#365.1,.04) to "Cancelled"
;
N FLD,HCT,SEG,STOP,TMP
S HCT="",STOP=0
F S HCT=$O(^TMP("HLS",$J,HCT)) Q:'HCT S SEG=$P(^(HCT),HLFS,1),TMP(SEG)=HCT
;
; Regular 270 Messages
I (EXT=1)!(EXT=2)!(EXT=5)!(EXT=6) D G BADMSGX
. I $$FOREIGN^IBCNINSU($P(PID,HLFS,6),"1;2;3;4;5;6") S STOP=1 Q ;PID-5 PATIENT NAME
. I $$FOREIGN^IBCNINSU($P(IN1,HLFS,3)) S STOP=1 Q ;IN1-2 PATIENT/SUBSCRIBER ID
. I $D(GT1) D I STOP Q
.. I $$FOREIGN^IBCNINSU($P(GT1,HLFS,3)) S STOP=1 Q ;GT1-2 SUBSCRIBER ID
.. I $$FOREIGN^IBCNINSU($P(GT1,HLFS,4),"1;2;3;4;5;6") S STOP=1 Q ;GT1-3 SUBSCRIBER NAME
. ;
. ;If foreign chars encountered clear field and continue with msg
. ;
. ; PID-11 Addr (street,ignore,city,state,zip)
. S FLD=$P(PID,HLFS,12) I $$FOREIGN^IBCNINSU(.FLD,"1;3;4;5",1) S $P(PID,HLFS,12)=FLD ;PID-11
. S FLD=$P(IN1,HLFS,9) I $$FOREIGN^IBCNINSU(.FLD,1,1) S $P(IN1,HLFS,9)=FLD ;IN1-8 GROUP NUMBER
. S FLD=$P(IN1,HLFS,10) I $$FOREIGN^IBCNINSU(.FLD,1,1) S $P(IN1,HLFS,10)=FLD ;IN1-9 GROUP NAME
. ;
. I $D(GT1) D
.. ; GT1-6 Addr (street,ignore,city,state,zip)
.. S FLD=$P(GT1,HLFS,7) I $$FOREIGN^IBCNINSU(.FLD,"1;3;4;5",1) S $P(GT1,HLFS,7)=FLD ;GT1-6
;
; EICD-Identifications (aka A1 msgs)
; [Asking clearinghouse if they know insurance for this patient]
I (EXT=4),(QUERY="I") D G BADMSGX
. I $$FOREIGN^IBCNINSU($P(PID,HLFS,6),"1;2;3;4;5;6") S STOP=1 Q ;PID-5 PATIENT NAME
. ; PID-11 Addr (ignore,ignore,city,state,zip)
. I $$FOREIGN^IBCNINSU($P(PID,HLFS,12),"3;4;5") S STOP=1 Q ;PID-11
. ;
. ;If foreign chars encountered clear field and continue with msg
. ;
. S FLD=$P(PID,HLFS,12) I $$FOREIGN^IBCNINSU(.FLD,1,1) S $P(PID,HLFS,12)=FLD ;PID-11-1 ADDR STREET
;
; EICD-Verification (aka A2 msgs)
; [Confirming policies clearinghouse found for VA]
I (EXT=4),(QUERY="V") D G BADMSGX
. I $$FOREIGN^IBCNINSU($P(PID,HLFS,6),"1;2;3;4;5;6") S STOP=1 Q ;PID-5 PATIENT NAME
. I $$FOREIGN^IBCNINSU($P(IN1,HLFS,3)) S STOP=1 Q ;IN1-2 PATIENT/SUBSCRIBER ID
. I $D(GT1) D I STOP Q
.. I $$FOREIGN^IBCNINSU($P(GT1,HLFS,3)) S STOP=1 Q ;GT1-2 SUBSCRIBER ID
.. I $$FOREIGN^IBCNINSU($P(GT1,HLFS,4),"1;2;3;4;5;6") S STOP=1 Q ;GT1-3 SUBSCRIBER NAME
. ;
. ;If foreign chars encountered clear field and continue with msg
. ;
. ; PID-11 Addr (street,ignore,city,state,zip)
. S FLD=$P(PID,HLFS,12) I $$FOREIGN^IBCNINSU(.FLD,"1;3;4;5",1) S $P(PID,HLFS,12)=FLD ;PID-11
. S FLD=$P(IN1,HLFS,9) I $$FOREIGN^IBCNINSU(.FLD,1,1) S $P(IN1,HLFS,9)=FLD ;IN1-8 GROUP NUMBER
. S FLD=$P(IN1,HLFS,10) I $$FOREIGN^IBCNINSU(.FLD,1,1) S $P(IN1,HLFS,10)=FLD ;IN1-9 GROUP NAME
. I $D(GT1) D
.. ; GT1-6 Addr (street,ignore,city,state,zip)
.. S FLD=$P(GT1,HLFS,7) I $$FOREIGN^IBCNINSU(.FLD,"1;3;4;5",1) S $P(GT1,HLFS,7)=FLD ;GT1-6
;
; MBI REQUEST
I EXT=7 D G BADMSGX
. I $$FOREIGN^IBCNINSU($P(PID,HLFS,6),"1;2;3;4;5;6") S STOP=1 Q ;PID-5 SUBSCRIBER NAME
. ;
. ;If foreign chars encountered clear field and continue with msg
. ;
. ; PID-11 Addr (street,ignore,city,state,zip)
. S FLD=$P(PID,HLFS,12) I $$FOREIGN^IBCNINSU(.FLD,"1;3;4;5",1) S $P(PID,HLFS,12)=FLD ;PID-11
;
BADMSGX ;Exit BADMSG
I 'STOP D
. S HCT=$G(TMP("PID")) I HCT S ^TMP("HLS",$J,HCT)=PID
. S HCT=$G(TMP("IN1")) I HCT S ^TMP("HLS",$J,HCT)=IN1
. S HCT=$G(TMP("GT1")) I HCT S ^TMP("HLS",$J,HCT)=GT1
Q STOP
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNEUT2 5647 printed Oct 16, 2024@18:16:11 Page 2
IBCNEUT2 ;DAOU/DAC - eIV MISC. UTILITIES ;06-JUN-2002
+1 ;;2.0;INTEGRATED BILLING;**184,416,435,713,737**;21-MAR-94;Build 19
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Can't be called from the top
+5 QUIT
+6 ;
SAVETQ(IEN,TDT) ; Update service date in TQ record
+1 ;
+2 NEW DIE,DA,DR,D,D0,DI,DIC,DQ,X
+3 SET DIE="^IBCN(365.1,"
SET DA=IEN
SET DR=".12////"_TDT
+4 DO ^DIE
+5 QUIT
+6 ;
+7 ;
SST(IEN,STAT) ; Set the Transmission Queue Status
+1 ; Input parameters
+2 ; IEN = Internal entry number for the record
+3 ; STAT= Status IEN
+4 ;
+5 NEW DIE,DA,DR,D,D0,DI,DIC,DQ,X
+6 ;
+7 IF IEN=""
QUIT
+8 ;
+9 SET DIE="^IBCN(365.1,"
SET DA=IEN
SET DR=".04////^S X=STAT;.15////^S X=$$NOW^XLFDT()"
+10 DO ^DIE
+11 QUIT
+12 ;
RSP(IEN,STAT) ; Set the Response File Status
+1 ; Input parameters
+2 ; IEN = Internal entry number for the record
+3 ; STAT= Status IEN
+4 ;
+5 NEW DIE,DA,DR,D,D0,DI,DIC,DQ,X
+6 SET DIE="^IBCN(365,"
SET DA=IEN
SET DR=".06////^S X=STAT"
+7 DO ^DIE
+8 QUIT
+9 ;
BUFF(BUFF,BNG) ; Set error symbol into Buffer File
+1 ; Input Parameter
+2 ; BUFF = Buffer internal entry number
+3 ; BNG = Buffer Symbol IEN
+4 IF 'BUFF!'BNG
QUIT
+5 ; .12 field not for ePharmacy IB*2*435
IF +$PIECE($GET(^IBA(355.33,BUFF,0)),U,17)
QUIT
+6 NEW DIE,DA,DR,D,D0,DI,DIC,DQ,X,DISYS
+7 SET DIE="^IBA(355.33,"
SET DA=BUFF
SET DR=".12////^S X=BNG"
+8 DO ^DIE
+9 QUIT
+10 ;
BADMSG(EXT,QUERY) ; Checks to see if the msg is allowed
+1 ; IB*713 Introduced this tag, checks for foreign characters as defined
+2 ; in FOREIGN^IBCNINSU. If foreign characters are encountered, some
+3 ; times the msg can't be created/sent via HL7. Other times, if you
+4 ; clear out the field with the foreign character you can still send
+5 ; the message. (Watch for the STOP variable.)
+6 ; This could be expanded in the future to check other scenarios that
+7 ; should stop the transmissions.
+8 ;
+9 ;INPUT:
+10 ; EXT = WHICH EXTRACT (#365.1,.1)
+11 ; QUERY = QUERY FLAG(#365.1,.11)
+12 ; PID, IN1, HLFS, HLECH - existing global variables
+13 ; GT1 global variable that may or may not exist
+14 ;
+15 ;OUTPUT: 0 - Continue with creating and sending HL7 msg
+16 ; 1 - Do not send this TQ entry out as a HL7 msg
+17 ; * NOTE: If Abort, this function sets the
+18 ; TRANSMISSION QUEUE (#365.1,.04) to "Cancelled"
+19 ;
+20 NEW FLD,HCT,SEG,STOP,TMP
+21 SET HCT=""
SET STOP=0
+22 FOR
SET HCT=$ORDER(^TMP("HLS",$JOB,HCT))
if 'HCT
QUIT
SET SEG=$PIECE(^(HCT),HLFS,1)
SET TMP(SEG)=HCT
+23 ;
+24 ; Regular 270 Messages
+25 IF (EXT=1)!(EXT=2)!(EXT=5)!(EXT=6)
Begin DoDot:1
+26 ;PID-5 PATIENT NAME
IF $$FOREIGN^IBCNINSU($PIECE(PID,HLFS,6),"1;2;3;4;5;6")
SET STOP=1
QUIT
+27 ;IN1-2 PATIENT/SUBSCRIBER ID
IF $$FOREIGN^IBCNINSU($PIECE(IN1,HLFS,3))
SET STOP=1
QUIT
+28 IF $DATA(GT1)
Begin DoDot:2
+29 ;GT1-2 SUBSCRIBER ID
IF $$FOREIGN^IBCNINSU($PIECE(GT1,HLFS,3))
SET STOP=1
QUIT
+30 ;GT1-3 SUBSCRIBER NAME
IF $$FOREIGN^IBCNINSU($PIECE(GT1,HLFS,4),"1;2;3;4;5;6")
SET STOP=1
QUIT
End DoDot:2
IF STOP
QUIT
+31 ;
+32 ;If foreign chars encountered clear field and continue with msg
+33 ;
+34 ; PID-11 Addr (street,ignore,city,state,zip)
+35 ;PID-11
SET FLD=$PIECE(PID,HLFS,12)
IF $$FOREIGN^IBCNINSU(.FLD,"1;3;4;5",1)
SET $PIECE(PID,HLFS,12)=FLD
+36 ;IN1-8 GROUP NUMBER
SET FLD=$PIECE(IN1,HLFS,9)
IF $$FOREIGN^IBCNINSU(.FLD,1,1)
SET $PIECE(IN1,HLFS,9)=FLD
+37 ;IN1-9 GROUP NAME
SET FLD=$PIECE(IN1,HLFS,10)
IF $$FOREIGN^IBCNINSU(.FLD,1,1)
SET $PIECE(IN1,HLFS,10)=FLD
+38 ;
+39 IF $DATA(GT1)
Begin DoDot:2
+40 ; GT1-6 Addr (street,ignore,city,state,zip)
+41 ;GT1-6
SET FLD=$PIECE(GT1,HLFS,7)
IF $$FOREIGN^IBCNINSU(.FLD,"1;3;4;5",1)
SET $PIECE(GT1,HLFS,7)=FLD
End DoDot:2
End DoDot:1
GOTO BADMSGX
+42 ;
+43 ; EICD-Identifications (aka A1 msgs)
+44 ; [Asking clearinghouse if they know insurance for this patient]
+45 IF (EXT=4)
IF (QUERY="I")
Begin DoDot:1
+46 ;PID-5 PATIENT NAME
IF $$FOREIGN^IBCNINSU($PIECE(PID,HLFS,6),"1;2;3;4;5;6")
SET STOP=1
QUIT
+47 ; PID-11 Addr (ignore,ignore,city,state,zip)
+48 ;PID-11
IF $$FOREIGN^IBCNINSU($PIECE(PID,HLFS,12),"3;4;5")
SET STOP=1
QUIT
+49 ;
+50 ;If foreign chars encountered clear field and continue with msg
+51 ;
+52 ;PID-11-1 ADDR STREET
SET FLD=$PIECE(PID,HLFS,12)
IF $$FOREIGN^IBCNINSU(.FLD,1,1)
SET $PIECE(PID,HLFS,12)=FLD
End DoDot:1
GOTO BADMSGX
+53 ;
+54 ; EICD-Verification (aka A2 msgs)
+55 ; [Confirming policies clearinghouse found for VA]
+56 IF (EXT=4)
IF (QUERY="V")
Begin DoDot:1
+57 ;PID-5 PATIENT NAME
IF $$FOREIGN^IBCNINSU($PIECE(PID,HLFS,6),"1;2;3;4;5;6")
SET STOP=1
QUIT
+58 ;IN1-2 PATIENT/SUBSCRIBER ID
IF $$FOREIGN^IBCNINSU($PIECE(IN1,HLFS,3))
SET STOP=1
QUIT
+59 IF $DATA(GT1)
Begin DoDot:2
+60 ;GT1-2 SUBSCRIBER ID
IF $$FOREIGN^IBCNINSU($PIECE(GT1,HLFS,3))
SET STOP=1
QUIT
+61 ;GT1-3 SUBSCRIBER NAME
IF $$FOREIGN^IBCNINSU($PIECE(GT1,HLFS,4),"1;2;3;4;5;6")
SET STOP=1
QUIT
End DoDot:2
IF STOP
QUIT
+62 ;
+63 ;If foreign chars encountered clear field and continue with msg
+64 ;
+65 ; PID-11 Addr (street,ignore,city,state,zip)
+66 ;PID-11
SET FLD=$PIECE(PID,HLFS,12)
IF $$FOREIGN^IBCNINSU(.FLD,"1;3;4;5",1)
SET $PIECE(PID,HLFS,12)=FLD
+67 ;IN1-8 GROUP NUMBER
SET FLD=$PIECE(IN1,HLFS,9)
IF $$FOREIGN^IBCNINSU(.FLD,1,1)
SET $PIECE(IN1,HLFS,9)=FLD
+68 ;IN1-9 GROUP NAME
SET FLD=$PIECE(IN1,HLFS,10)
IF $$FOREIGN^IBCNINSU(.FLD,1,1)
SET $PIECE(IN1,HLFS,10)=FLD
+69 IF $DATA(GT1)
Begin DoDot:2
+70 ; GT1-6 Addr (street,ignore,city,state,zip)
+71 ;GT1-6
SET FLD=$PIECE(GT1,HLFS,7)
IF $$FOREIGN^IBCNINSU(.FLD,"1;3;4;5",1)
SET $PIECE(GT1,HLFS,7)=FLD
End DoDot:2
End DoDot:1
GOTO BADMSGX
+72 ;
+73 ; MBI REQUEST
+74 IF EXT=7
Begin DoDot:1
+75 ;PID-5 SUBSCRIBER NAME
IF $$FOREIGN^IBCNINSU($PIECE(PID,HLFS,6),"1;2;3;4;5;6")
SET STOP=1
QUIT
+76 ;
+77 ;If foreign chars encountered clear field and continue with msg
+78 ;
+79 ; PID-11 Addr (street,ignore,city,state,zip)
+80 ;PID-11
SET FLD=$PIECE(PID,HLFS,12)
IF $$FOREIGN^IBCNINSU(.FLD,"1;3;4;5",1)
SET $PIECE(PID,HLFS,12)=FLD
End DoDot:1
GOTO BADMSGX
+81 ;
BADMSGX ;Exit BADMSG
+1 IF 'STOP
Begin DoDot:1
+2 SET HCT=$GET(TMP("PID"))
IF HCT
SET ^TMP("HLS",$JOB,HCT)=PID
+3 SET HCT=$GET(TMP("IN1"))
IF HCT
SET ^TMP("HLS",$JOB,HCT)=IN1
+4 SET HCT=$GET(TMP("GT1"))
IF HCT
SET ^TMP("HLS",$JOB,HCT)=GT1
End DoDot:1
+5 QUIT STOP
