Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCNEUT2

IBCNEUT2.m

Go to the documentation of this file.
  1. IBCNEUT2 ;DAOU/DAC - eIV MISC. UTILITIES ;06-JUN-2002
  1. ;;2.0;INTEGRATED BILLING;**184,416,435,713,737**;21-MAR-94;Build 19
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; Can't be called from the top
  1. Q
  1. ;
  1. SAVETQ(IEN,TDT) ; Update service date in TQ record
  1. ;
  1. N DIE,DA,DR,D,D0,DI,DIC,DQ,X
  1. S DIE="^IBCN(365.1,",DA=IEN,DR=".12////"_TDT
  1. D ^DIE
  1. Q
  1. ;
  1. ;
  1. SST(IEN,STAT) ; Set the Transmission Queue Status
  1. ; Input parameters
  1. ; IEN = Internal entry number for the record
  1. ; STAT= Status IEN
  1. ;
  1. NEW DIE,DA,DR,D,D0,DI,DIC,DQ,X
  1. ;
  1. I IEN="" Q
  1. ;
  1. S DIE="^IBCN(365.1,",DA=IEN,DR=".04////^S X=STAT;.15////^S X=$$NOW^XLFDT()"
  1. D ^DIE
  1. Q
  1. ;
  1. RSP(IEN,STAT) ; Set the Response File Status
  1. ; Input parameters
  1. ; IEN = Internal entry number for the record
  1. ; STAT= Status IEN
  1. ;
  1. NEW DIE,DA,DR,D,D0,DI,DIC,DQ,X
  1. S DIE="^IBCN(365,",DA=IEN,DR=".06////^S X=STAT"
  1. D ^DIE
  1. Q
  1. ;
  1. BUFF(BUFF,BNG) ; Set error symbol into Buffer File
  1. ; Input Parameter
  1. ; BUFF = Buffer internal entry number
  1. ; BNG = Buffer Symbol IEN
  1. I 'BUFF!'BNG Q
  1. I +$P($G(^IBA(355.33,BUFF,0)),U,17) Q ; .12 field not for ePharmacy IB*2*435
  1. NEW DIE,DA,DR,D,D0,DI,DIC,DQ,X,DISYS
  1. S DIE="^IBA(355.33,",DA=BUFF,DR=".12////^S X=BNG"
  1. D ^DIE
  1. Q
  1. ;
  1. BADMSG(EXT,QUERY) ; Checks to see if the msg is allowed
  1. ; IB*713 Introduced this tag, checks for foreign characters as defined
  1. ; in FOREIGN^IBCNINSU. If foreign characters are encountered, some
  1. ; times the msg can't be created/sent via HL7. Other times, if you
  1. ; clear out the field with the foreign character you can still send
  1. ; the message. (Watch for the STOP variable.)
  1. ; This could be expanded in the future to check other scenarios that
  1. ; should stop the transmissions.
  1. ;
  1. ;INPUT:
  1. ; EXT = WHICH EXTRACT (#365.1,.1)
  1. ; QUERY = QUERY FLAG(#365.1,.11)
  1. ; PID, IN1, HLFS, HLECH - existing global variables
  1. ; GT1 global variable that may or may not exist
  1. ;
  1. ;OUTPUT: 0 - Continue with creating and sending HL7 msg
  1. ; 1 - Do not send this TQ entry out as a HL7 msg
  1. ; * NOTE: If Abort, this function sets the
  1. ; TRANSMISSION QUEUE (#365.1,.04) to "Cancelled"
  1. ;
  1. N FLD,HCT,SEG,STOP,TMP
  1. S HCT="",STOP=0
  1. F S HCT=$O(^TMP("HLS",$J,HCT)) Q:'HCT S SEG=$P(^(HCT),HLFS,1),TMP(SEG)=HCT
  1. ;
  1. ; Regular 270 Messages
  1. I (EXT=1)!(EXT=2)!(EXT=5)!(EXT=6) D G BADMSGX
  1. . I $$FOREIGN^IBCNINSU($P(PID,HLFS,6),"1;2;3;4;5;6") S STOP=1 Q ;PID-5 PATIENT NAME
  1. . I $$FOREIGN^IBCNINSU($P(IN1,HLFS,3)) S STOP=1 Q ;IN1-2 PATIENT/SUBSCRIBER ID
  1. . I $D(GT1) D I STOP Q
  1. .. I $$FOREIGN^IBCNINSU($P(GT1,HLFS,3)) S STOP=1 Q ;GT1-2 SUBSCRIBER ID
  1. .. I $$FOREIGN^IBCNINSU($P(GT1,HLFS,4),"1;2;3;4;5;6") S STOP=1 Q ;GT1-3 SUBSCRIBER NAME
  1. . ;
  1. . ;If foreign chars encountered clear field and continue with msg
  1. . ;
  1. . ; PID-11 Addr (street,ignore,city,state,zip)
  1. . S FLD=$P(PID,HLFS,12) I $$FOREIGN^IBCNINSU(.FLD,"1;3;4;5",1) S $P(PID,HLFS,12)=FLD ;PID-11
  1. . S FLD=$P(IN1,HLFS,9) I $$FOREIGN^IBCNINSU(.FLD,1,1) S $P(IN1,HLFS,9)=FLD ;IN1-8 GROUP NUMBER
  1. . S FLD=$P(IN1,HLFS,10) I $$FOREIGN^IBCNINSU(.FLD,1,1) S $P(IN1,HLFS,10)=FLD ;IN1-9 GROUP NAME
  1. . ;
  1. . I $D(GT1) D
  1. .. ; GT1-6 Addr (street,ignore,city,state,zip)
  1. .. S FLD=$P(GT1,HLFS,7) I $$FOREIGN^IBCNINSU(.FLD,"1;3;4;5",1) S $P(GT1,HLFS,7)=FLD ;GT1-6
  1. ;
  1. ; EICD-Identifications (aka A1 msgs)
  1. ; [Asking clearinghouse if they know insurance for this patient]
  1. I (EXT=4),(QUERY="I") D G BADMSGX
  1. . I $$FOREIGN^IBCNINSU($P(PID,HLFS,6),"1;2;3;4;5;6") S STOP=1 Q ;PID-5 PATIENT NAME
  1. . ; PID-11 Addr (ignore,ignore,city,state,zip)
  1. . I $$FOREIGN^IBCNINSU($P(PID,HLFS,12),"3;4;5") S STOP=1 Q ;PID-11
  1. . ;
  1. . ;If foreign chars encountered clear field and continue with msg
  1. . ;
  1. . S FLD=$P(PID,HLFS,12) I $$FOREIGN^IBCNINSU(.FLD,1,1) S $P(PID,HLFS,12)=FLD ;PID-11-1 ADDR STREET
  1. ;
  1. ; EICD-Verification (aka A2 msgs)
  1. ; [Confirming policies clearinghouse found for VA]
  1. I (EXT=4),(QUERY="V") D G BADMSGX
  1. . I $$FOREIGN^IBCNINSU($P(PID,HLFS,6),"1;2;3;4;5;6") S STOP=1 Q ;PID-5 PATIENT NAME
  1. . I $$FOREIGN^IBCNINSU($P(IN1,HLFS,3)) S STOP=1 Q ;IN1-2 PATIENT/SUBSCRIBER ID
  1. . I $D(GT1) D I STOP Q
  1. .. I $$FOREIGN^IBCNINSU($P(GT1,HLFS,3)) S STOP=1 Q ;GT1-2 SUBSCRIBER ID
  1. .. I $$FOREIGN^IBCNINSU($P(GT1,HLFS,4),"1;2;3;4;5;6") S STOP=1 Q ;GT1-3 SUBSCRIBER NAME
  1. . ;
  1. . ;If foreign chars encountered clear field and continue with msg
  1. . ;
  1. . ; PID-11 Addr (street,ignore,city,state,zip)
  1. . S FLD=$P(PID,HLFS,12) I $$FOREIGN^IBCNINSU(.FLD,"1;3;4;5",1) S $P(PID,HLFS,12)=FLD ;PID-11
  1. . S FLD=$P(IN1,HLFS,9) I $$FOREIGN^IBCNINSU(.FLD,1,1) S $P(IN1,HLFS,9)=FLD ;IN1-8 GROUP NUMBER
  1. . S FLD=$P(IN1,HLFS,10) I $$FOREIGN^IBCNINSU(.FLD,1,1) S $P(IN1,HLFS,10)=FLD ;IN1-9 GROUP NAME
  1. . I $D(GT1) D
  1. .. ; GT1-6 Addr (street,ignore,city,state,zip)
  1. .. S FLD=$P(GT1,HLFS,7) I $$FOREIGN^IBCNINSU(.FLD,"1;3;4;5",1) S $P(GT1,HLFS,7)=FLD ;GT1-6
  1. ;
  1. ; MBI REQUEST
  1. I EXT=7 D G BADMSGX
  1. . I $$FOREIGN^IBCNINSU($P(PID,HLFS,6),"1;2;3;4;5;6") S STOP=1 Q ;PID-5 SUBSCRIBER NAME
  1. . ;
  1. . ;If foreign chars encountered clear field and continue with msg
  1. . ;
  1. . ; PID-11 Addr (street,ignore,city,state,zip)
  1. . S FLD=$P(PID,HLFS,12) I $$FOREIGN^IBCNINSU(.FLD,"1;3;4;5",1) S $P(PID,HLFS,12)=FLD ;PID-11
  1. ;
  1. BADMSGX ;Exit BADMSG
  1. I 'STOP D
  1. . S HCT=$G(TMP("PID")) I HCT S ^TMP("HLS",$J,HCT)=PID
  1. . S HCT=$G(TMP("IN1")) I HCT S ^TMP("HLS",$J,HCT)=IN1
  1. . S HCT=$G(TMP("GT1")) I HCT S ^TMP("HLS",$J,HCT)=GT1
  1. Q STOP