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

IBBAADTI.m

Go to the documentation of this file. 
  1. IBBAADTI ;OAK/ELZ - PFSS INBOUND FILER ;15-MAR-2005
  1.  ;;2.0;INTEGRATED BILLING;**286**;21-MAR-94
  1.  ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1. A04 ;receiver for returned A04 messages to create account
  1.  N IBBHDR,IBBMSG,IBBDFN,IBBARFN,IBBEXVN,HLERR
  1.  Q:'$$STARTMSG^HLPRS(.IBBMSG,HLMTIENS,.IBBHDR)
  1.  I $G(IBBHDR("EVENT"))'="A04" Q
  1.  S IBBDFN=+$$PID()
  1.  I 'IBBDFN S HLERR="Patient data could not be matched to database." D NAK Q
  1.  S IBBEXVN=+$$EXVN()
  1.  I 'IBBEXVN S HLERR="External billing system account # is not defined." D NAK Q
  1.  S IBBARFN=$$SET(IBBDFN,HLMTIENS)
  1.  I 'IBBARFN S HLERR="External billing system account # could not be filed." D NAK Q
  1.  I IBBARFN D ACK
  1.  Q
  1.  ;
  1. A05 ;receiver for returned A05 messages to create account
  1.  N IBBHDR,IBBMSG,IBBDFN,IBBARFN,IBBEXVN,HLERR
  1.  Q:'$$STARTMSG^HLPRS(.IBBMSG,HLMTIENS,.IBBHDR)
  1.  I $G(IBBHDR("EVENT"))'="A05" Q
  1.  S IBBDFN=$$PID()
  1.  I 'IBBDFN S HLERR="Patient data could not be matched to database." D NAK Q
  1.  S IBBEXVN=+$$EXVN()
  1.  I 'IBBEXVN S HLERR="External billing system account # is not defined." D NAK Q
  1.  S IBBARFN=$$SET(IBBDFN,HLMTIENS)
  1.  I 'IBBARFN S HLERR="External billing system account # could not be filed." D NAK Q
  1.  I IBBARFN D ACK
  1.  Q
  1.  ;
  1. SET(IBBDFN,HLMTIENS) ;set returned external account number in file #375
  1.  N DIC,IEN1,IEN2,IENS,REC,PHYS,PHYSX,ALTNUM,ALTNUMX,PROC,PROCX,OUT,OK,X,XX
  1.  N IBBEVENT,IBBEXVN,IBBWHEN,IBBWHERE,IBBARFN,IBBIEN,IBBMSG,IBBHDR,IBBSEG,IBBARRAY
  1.  S IBBARFN=""
  1.  Q:'$G(HLMTIENS) IBBARFN
  1.  Q:'$G(IBBDFN) IBBARFN
  1.  Q:'$$STARTMSG^HLPRS(.IBBMSG,HLMTIENS,.IBBHDR) IBBARFN
  1.  ;parse critical data elements from HL7 msg
  1.  S OUT=0
  1.  F  Q:OUT  Q:'$$NEXTSEG^HLPRS(.IBBMSG,.IBBSEG)  D
  1.  .I IBBSEG("SEGMENT TYPE")="EVN" D  Q
  1.  ..S (XX,IBBEVENT)=$$GET^HLOPRS(.IBBSEG,1,1,)
  1.  ..I ";A01;A04;A05;"'[(";"_XX_";") S OUT=1
  1.  .I IBBSEG("SEGMENT TYPE")="PV1" D  Q
  1.  ..S IBBWHERE=$$GET^HLOPRS(.IBBSEG,3,1)
  1.  ..S PHYS=$E($$GET^HLOPRS(.IBBSEG,7,1),4,99)
  1.  ..S IBBARFN=$$GET^HLOPRS(.IBBSEG,5,1)
  1.  ..S IBBEXVN=$$GET^HLOPRS(.IBBSEG,19,1)
  1.  ..S ALTNUM=$$GET^HLOPRS(.IBBSEG,50,1)
  1.  ..S XX=$$GET^HLOPRS(.IBBSEG,44,1),IBBWHEN=$$FMDATE^HLFNC(XX)
  1.  .I IBBSEG("SEGMENT TYPE")="PR1" D  Q
  1.  ..S PROC=$$GET^HLOPRS(.IBBSEG,3,1)
  1.  ;exit if not event type of interest
  1.  Q:OUT IBBARFN
  1.  ;exit if external visit already known for A01 event
  1.  I IBBEVENT="A01",IBBWHERE'="FEE BASIS" S X=$$INTNUM(IBBEXVN) I X S IBBARFN=X Q IBBARFN
  1.  ;resolve location
  1.  I IBBWHERE'="FEE BASIS" D
  1.  .K Y S DIC=44,DIC(0)="MXZ",X=IBBWHERE
  1.  .D ^DIC
  1.  .I $P($G(Y),U,2)=IBBWHERE S IBBWHERE=+Y
  1.  I IBBWHERE="FEE BASIS" S IBBWHEN=$P(IBBWHEN,".",1)
  1.  ;verify account record if IBBARFN is not null
  1.  I IBBARFN D  I 'OK S IBBARFN=""
  1.  .S OK=1,IBBIEN=0
  1.  .S IENS=IBBARFN_"," D GETS^DIQ(375,IENS,".01;.03;1.03;1.44;16.01","I","IBBARRAY")
  1.  .I IBBARFN'=$G(IBBARRAY(375,IENS,.01,"I")) S OK=0 Q
  1.  .I IBBDFN'=$G(IBBARRAY(375,IENS,.03,"I")) S OK=0 Q
  1.  .I IBBWHEN'=$G(IBBARRAY(375,IENS,1.44,"I")) S OK=0 Q
  1.  .I IBBEVENT="A01",IBBWHERE'=$G(IBBARRAY(375,IENS,16.01,"I")) S OK=0 Q
  1.  .I ((IBBEVENT="A04")!(IBBEVENT="A05"))&(IBBWHERE'=$G(IBBARRAY(375,IENS,1.03,"I"))) S OK=0 Q
  1.  .S IBBIEN=IBBARFN
  1.  ;find account record if IBBARFN is null; should be used (normally) only for inpatient A01
  1.  I 'IBBARFN D
  1.  .S IBBIEN=0
  1.  .I IBBWHERE=+IBBWHERE D
  1.  ..S IEN1=+$O(^IBBAA(375,"AC",IBBDFN,IBBWHEN,IBBWHERE,0))
  1.  ..S IEN2=+$O(^IBBAA(375,"AC",IBBDFN,IBBWHEN,IBBWHERE,IEN1))
  1.  .I IBBWHERE'=+IBBWHERE D
  1.  ..S IEN1=+$O(^IBBAA(375,"AF",IBBDFN,IBBWHEN,IBBWHERE,0))
  1.  ..S IEN2=+$O(^IBBAA(375,"AF",IBBDFN,IBBWHEN,IBBWHERE,IEN1))
  1.  .;inpatient admission
  1.  .I 'IEN1,IBBEVENT="A01",IBBWHERE'="FEE BASIS" S IBBIEN=$$INPT() Q
  1.  .;unique index entry
  1.  .I IEN1,'IEN2 S IBBIEN=IEN1
  1.  .;multiple index entries
  1.  .I 'IBBIEN,IEN2,IBBWHERE=+IBBWHERE D
  1.  ..S IEN1=0 F  S IEN1=+$O(^IBBAA(375,"AC",IBBDFN,IBBWHEN,IBBWHERE,IEN1)) Q:'IEN1  D  Q:IBBIEN
  1.  ...S REC=$G(^IBBAA(375,IEN1,"PV1")),ALTNUMX=+$P(REC,U,50)
  1.  ...I $G(ALTNUM),ALTNUMX=ALTNUM S IBBIEN=IEN1 Q
  1.  ...I $G(ALTNUM),ALTNUMX'=ALTNUM Q
  1.  ...S PHYSX=$P(REC,U,7)
  1.  ...I $G(PHYS),PHYSX=PHYS S IBBIEN=IEN1 Q
  1.  ...I $G(PHYS),PHYSX'=PHYS Q
  1.  ...I $G(PROC)'="" S PROC=$$CODEN^ICPTCOD(PROC),PROCX=$P($G(^IBBAA(375,IEN1,"PR1")),U,3)
  1.  ...I +PROC,PROCX=PROC S IBBIEN=IEN1 Q
  1.  ;store external visit #
  1.  I $G(IBBIEN) D
  1.  .S:('IBBARFN) IBBARFN=IBBIEN
  1.  .I $P(^IBBAA(375,IBBIEN,0),U,2)="" D
  1.  ..S $P(^IBBAA(375,IBBIEN,0),U,2)=IBBEXVN
  1.  ..S $P(^IBBAA(375,IBBIEN,0),U,5)=$$NOW^XLFDT()
  1.  ..D EVENT^IBBAACCT(IBBIEN,IBBEVENT,"I")
  1.  Q IBBARFN
  1.  ;
  1. INPT() ;set new account record for inpatient admission
  1.  N IBB,IBBARFN,IBBIEN,IBBIENS,IBBERR,FDA,X
  1.  S IBBARFN=0
  1.  L +^IBBAA(375,0):5
  1.  Q:'$T 0
  1.  S IBBIEN=$P(^IBBAA(375,0),U,3)+1
  1.  S IBBIEN(1)=IBBIEN
  1.  S IBBIENS="+1,"
  1.  S IBBERR="IBB(""DIERR"")"
  1.  S FDA(375,IBBIENS,.01)=IBBIEN
  1.  S FDA(375,IBBIENS,.02)=IBBEXVN
  1.  S FDA(375,IBBIENS,.03)=IBBDFN
  1.  S FDA(375,IBBIENS,.04)="COTS_SYSTEM"
  1.  S FDA(375,IBBIENS,.05)=$$NOW^XLFDT
  1.  D UPDATE^DIE("","FDA","IBBIEN",IBBERR)
  1.  L -^IBBAA(375,0)
  1.  I '$D(IBB("DIERR")) D
  1.  .S IBBARFN=IBBIEN
  1.  .S X="",$P(X,U,2)="I",$P(X,U,3)=IBBWHERE,$P(X,U,44)=IBBWHEN
  1.  .S ^IBBAA(375,IBBIEN,"PV1")=X
  1.  .D EVENT^IBBAACCT(IBBIEN,IBBEVENT,"I")
  1.  .S ^IBBAA(375,"AC",IBBDFN,IBBWHEN,IBBWHERE,IBBIEN)=""
  1.  Q IBBARFN
  1.  ;
  1. INTNUM(IBBEXVN) ;return PFSS Account Reference using external visit number
  1.  N IBBARFN,XX
  1.  S IBBARFN=""
  1.  Q:'$G(IBBEXVN) IBBARFN
  1.  S XX=$O(^IBBAA(375,"C",IBBEXVN,0))
  1.  I XX S IBBARFN=XX
  1.  Q IBBARFN
  1.  ;
  1. PID() ;get DFN from HL7 message; compare to file #2 data
  1.  N IBBARRY,OUT,REP,FILE,FIELD,IENS,XID,XTYP,XSITE,XSSN,XNAME,XX
  1.  S OUT=0,XID=0,XSSN=0
  1.  F  Q:OUT  Q:'$$NEXTSEG^HLPRS(.IBBMSG,.IBBSEG)  I IBBSEG("SEGMENT TYPE")="PID"  D
  1.  .S XNAME=$$GET^HLOPRS(.IBBSEG,5,1,1)
  1.  .F REP=1:1 Q:OUT  D
  1.  ..S XTYP=$$GET^HLOPRS(.IBBSEG,3,5,1,REP)
  1.  ..I XTYP="PI" D
  1.  ...S XX=$$GET^HLOPRS(.IBBSEG,3,1,1,REP)
  1.  ...S XSITE=+$E(XX,1,3),XID=+$E(XX,4,99)
  1.  ..I XTYP="SS" S XSSN=$$GET^HLOPRS(.IBBSEG,3,1,1,REP)
  1.  ..I XID&XSSN S OUT=1
  1.  I XSITE=$P($$SITE^VASITE(),U,3) D
  1.  .S FILE=2,IENS=XID_",",FIELD=".01;.09"
  1.  .D GETS^DIQ(FILE,IENS,FIELD,"","IBBARRY")
  1.  .I XSSN'=$G(IBBARRY(2,IENS,.09)) S XID=0
  1.  .I XNAME'=$P($G(IBBARRY(2,IENS,.01)),",",1) S XID=0
  1.  Q XID
  1.  ;
  1. EXVN() ;external account/visit number must be non-null
  1.  N OUT,IBBEXVN
  1.  S IBBEXVN="",OUT=0
  1.  F  Q:OUT  Q:'$$NEXTSEG^HLPRS(.IBBMSG,.IBBSEG)  D
  1.  .I IBBSEG("SEGMENT TYPE")="PV1" D  Q
  1.  ..S IBBEXVN=$$GET^HLOPRS(.IBBSEG,19,1),OUT=1
  1.  Q IBBEXVN
  1.  ;
  1. ACK ; prepare positive acknowledgement (AA) message
  1.  N HLA,HLRESULT
  1.  S XX=$$SETPURG^HLUTIL(0)
  1.  S HLA("HLA",$J,1)="MSA"_HL("FS")_"AA"_HL("FS")_HL("MID")
  1.  D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.HLRESULT)
  1.  Q
  1.  ;
  1. NAK ;prepare negative acknowledgement (AE) message
  1.  N HLA,HLRESULT
  1.  S XX=$$SETPURG^HLUTIL(1)
  1.  S HLA("HLA",$J,1)="MSA"_HL("FS")_"AE"_HL("FS")_HL("MID")_HL("FS")_HLERR
  1.  D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.HLRESULT)
  1.  Q
  1.  ;
  1. IBBACONV(IBBDFN,IBBTYPE,IBBWHEN,IBBWHERE,IBBEXVN) ;new account record for converted inpatient or outpatient
  1.  ;called only from DG or SD routine during back-load of converted data
  1.  ;input  IBBDFN   = pointer to file #2
  1.  ;       IBBTYPE  = I(npatient) or O(utpatient)
  1.  ;       IBBWHEN  = date/time of visit; internal FM format
  1.  ;       IBBWHERE = location of visit; pointer to file #44
  1.  ;       IBBEXVN  = external system visit #
  1.  ;output IBBARFN  = ien in file #375; PFSS Account Reference
  1.  ;       
  1.  N IBB,IBBARFN,IBBIEN,IBBIENS,IBBERR,FDA,X
  1.  S IBBARFN=0
  1.  L +^IBBAA(375,0):5
  1.  Q:'$T 0
  1.  S IBBIEN=$P(^IBBAA(375,0),U,3)+1
  1.  S IBBIEN(1)=IBBIEN
  1.  S IBBIENS="+1,"
  1.  S IBBERR="IBB(""DIERR"")"
  1.  S FDA(375,IBBIENS,.01)=IBBIEN
  1.  S FDA(375,IBBIENS,.02)=$G(IBBEXVN)
  1.  S FDA(375,IBBIENS,.03)=$G(IBBDFN)
  1.  S FDA(375,IBBIENS,.04)="CONVERSION"
  1.  S FDA(375,IBBIENS,.05)=$$NOW^XLFDT
  1.  D UPDATE^DIE("","FDA","IBBIEN",IBBERR)
  1.  L -^IBBAA(375,0)
  1.  I '$D(IBB("DIERR")) D
  1.  .S IBBARFN=IBBIEN
  1.  .S X="",$P(X,U,2)=$G(IBBTYPE),$P(X,U,3)=$G(IBBWHERE),$P(X,U,44)=$G(IBBWHEN)
  1.  .S ^IBBAA(375,IBBIEN,"PV1")=X
  1.  .I IBBTYPE="O" S $P(^IBBAA(375,IBBIEN,"PV2"),U,8)=$G(IBBWHEN)
  1.  .I $G(IBBDFN),$G(IBBWHEN),$G(IBBWHERE) S ^IBBAA(375,"AC",IBBDFN,IBBWHEN,IBBWHERE,IBBIEN)=""
  1.  Q IBBARFN