source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBBAADTI.m@ 1611

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