- 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 Feb 18, 2025@23:41:55 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