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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBBAADTI 8152 printed Dec 13, 2024@02:08:18 Page 2
IBBAADTI ;OAK/ELZ - PFSS INBOUND FILER ;15-MAR-2005
+1 ;;2.0;INTEGRATED BILLING;**286**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
A04 ;receiver for returned A04 messages to create account
+1 NEW IBBHDR,IBBMSG,IBBDFN,IBBARFN,IBBEXVN,HLERR
+2 if '$$STARTMSG^HLPRS(.IBBMSG,HLMTIENS,.IBBHDR)
QUIT
+3 IF $GET(IBBHDR("EVENT"))'="A04"
QUIT
+4 SET IBBDFN=+$$PID()
+5 IF 'IBBDFN
SET HLERR="Patient data could not be matched to database."
DO NAK
QUIT
+6 SET IBBEXVN=+$$EXVN()
+7 IF 'IBBEXVN
SET HLERR="External billing system account # is not defined."
DO NAK
QUIT
+8 SET IBBARFN=$$SET(IBBDFN,HLMTIENS)
+9 IF 'IBBARFN
SET HLERR="External billing system account # could not be filed."
DO NAK
QUIT
+10 IF IBBARFN
DO ACK
+11 QUIT
+12 ;
A05 ;receiver for returned A05 messages to create account
+1 NEW IBBHDR,IBBMSG,IBBDFN,IBBARFN,IBBEXVN,HLERR
+2 if '$$STARTMSG^HLPRS(.IBBMSG,HLMTIENS,.IBBHDR)
QUIT
+3 IF $GET(IBBHDR("EVENT"))'="A05"
QUIT
+4 SET IBBDFN=$$PID()
+5 IF 'IBBDFN
SET HLERR="Patient data could not be matched to database."
DO NAK
QUIT
+6 SET IBBEXVN=+$$EXVN()
+7 IF 'IBBEXVN
SET HLERR="External billing system account # is not defined."
DO NAK
QUIT
+8 SET IBBARFN=$$SET(IBBDFN,HLMTIENS)
+9 IF 'IBBARFN
SET HLERR="External billing system account # could not be filed."
DO NAK
QUIT
+10 IF IBBARFN
DO ACK
+11 QUIT
+12 ;
SET(IBBDFN,HLMTIENS) ;set returned external account number in file #375
+1 NEW DIC,IEN1,IEN2,IENS,REC,PHYS,PHYSX,ALTNUM,ALTNUMX,PROC,PROCX,OUT,OK,X,XX
+2 NEW IBBEVENT,IBBEXVN,IBBWHEN,IBBWHERE,IBBARFN,IBBIEN,IBBMSG,IBBHDR,IBBSEG,IBBARRAY
+3 SET IBBARFN=""
+4 if '$GET(HLMTIENS)
QUIT IBBARFN
+5 if '$GET(IBBDFN)
QUIT IBBARFN
+6 if '$$STARTMSG^HLPRS(.IBBMSG,HLMTIENS,.IBBHDR)
QUIT IBBARFN
+7 ;parse critical data elements from HL7 msg
+8 SET OUT=0
+9 FOR
if OUT
QUIT
if '$$NEXTSEG^HLPRS(.IBBMSG,.IBBSEG)
QUIT
Begin DoDot:1
+10 IF IBBSEG("SEGMENT TYPE")="EVN"
Begin DoDot:2
+11 SET (XX,IBBEVENT)=$$GET^HLOPRS(.IBBSEG,1,1,)
+12 IF ";A01;A04;A05;"'[(";"_XX_";")
SET OUT=1
End DoDot:2
QUIT
+13 IF IBBSEG("SEGMENT TYPE")="PV1"
Begin DoDot:2
+14 SET IBBWHERE=$$GET^HLOPRS(.IBBSEG,3,1)
+15 SET PHYS=$EXTRACT($$GET^HLOPRS(.IBBSEG,7,1),4,99)
+16 SET IBBARFN=$$GET^HLOPRS(.IBBSEG,5,1)
+17 SET IBBEXVN=$$GET^HLOPRS(.IBBSEG,19,1)
+18 SET ALTNUM=$$GET^HLOPRS(.IBBSEG,50,1)
+19 SET XX=$$GET^HLOPRS(.IBBSEG,44,1)
SET IBBWHEN=$$FMDATE^HLFNC(XX)
End DoDot:2
QUIT
+20 IF IBBSEG("SEGMENT TYPE")="PR1"
Begin DoDot:2
+21 SET PROC=$$GET^HLOPRS(.IBBSEG,3,1)
End DoDot:2
QUIT
End DoDot:1
+22 ;exit if not event type of interest
+23 if OUT
QUIT IBBARFN
+24 ;exit if external visit already known for A01 event
+25 IF IBBEVENT="A01"
IF IBBWHERE'="FEE BASIS"
SET X=$$INTNUM(IBBEXVN)
IF X
SET IBBARFN=X
QUIT IBBARFN
+26 ;resolve location
+27 IF IBBWHERE'="FEE BASIS"
Begin DoDot:1
+28 KILL Y
SET DIC=44
SET DIC(0)="MXZ"
SET X=IBBWHERE
+29 DO ^DIC
+30 IF $PIECE($GET(Y),U,2)=IBBWHERE
SET IBBWHERE=+Y
End DoDot:1
+31 IF IBBWHERE="FEE BASIS"
SET IBBWHEN=$PIECE(IBBWHEN,".",1)
+32 ;verify account record if IBBARFN is not null
+33 IF IBBARFN
Begin DoDot:1
+34 SET OK=1
SET IBBIEN=0
+35 SET IENS=IBBARFN_","
DO GETS^DIQ(375,IENS,".01;.03;1.03;1.44;16.01","I","IBBARRAY")
+36 IF IBBARFN'=$GET(IBBARRAY(375,IENS,.01,"I"))
SET OK=0
QUIT
+37 IF IBBDFN'=$GET(IBBARRAY(375,IENS,.03,"I"))
SET OK=0
QUIT
+38 IF IBBWHEN'=$GET(IBBARRAY(375,IENS,1.44,"I"))
SET OK=0
QUIT
+39 IF IBBEVENT="A01"
IF IBBWHERE'=$GET(IBBARRAY(375,IENS,16.01,"I"))
SET OK=0
QUIT
+40 IF ((IBBEVENT="A04")!(IBBEVENT="A05"))&(IBBWHERE'=$GET(IBBARRAY(375,IENS,1.03,"I")))
SET OK=0
QUIT
+41 SET IBBIEN=IBBARFN
End DoDot:1
IF 'OK
SET IBBARFN=""
+42 ;find account record if IBBARFN is null; should be used (normally) only for inpatient A01
+43 IF 'IBBARFN
Begin DoDot:1
+44 SET IBBIEN=0
+45 IF IBBWHERE=+IBBWHERE
Begin DoDot:2
+46 SET IEN1=+$ORDER(^IBBAA(375,"AC",IBBDFN,IBBWHEN,IBBWHERE,0))
+47 SET IEN2=+$ORDER(^IBBAA(375,"AC",IBBDFN,IBBWHEN,IBBWHERE,IEN1))
End DoDot:2
+48 IF IBBWHERE'=+IBBWHERE
Begin DoDot:2
+49 SET IEN1=+$ORDER(^IBBAA(375,"AF",IBBDFN,IBBWHEN,IBBWHERE,0))
+50 SET IEN2=+$ORDER(^IBBAA(375,"AF",IBBDFN,IBBWHEN,IBBWHERE,IEN1))
End DoDot:2
+51 ;inpatient admission
+52 IF 'IEN1
IF IBBEVENT="A01"
IF IBBWHERE'="FEE BASIS"
SET IBBIEN=$$INPT()
QUIT
+53 ;unique index entry
+54 IF IEN1
IF 'IEN2
SET IBBIEN=IEN1
+55 ;multiple index entries
+56 IF 'IBBIEN
IF IEN2
IF IBBWHERE=+IBBWHERE
Begin DoDot:2
+57 SET IEN1=0
FOR
SET IEN1=+$ORDER(^IBBAA(375,"AC",IBBDFN,IBBWHEN,IBBWHERE,IEN1))
if 'IEN1
QUIT
Begin DoDot:3
+58 SET REC=$GET(^IBBAA(375,IEN1,"PV1"))
SET ALTNUMX=+$PIECE(REC,U,50)
+59 IF $GET(ALTNUM)
IF ALTNUMX=ALTNUM
SET IBBIEN=IEN1
QUIT
+60 IF $GET(ALTNUM)
IF ALTNUMX'=ALTNUM
QUIT
+61 SET PHYSX=$PIECE(REC,U,7)
+62 IF $GET(PHYS)
IF PHYSX=PHYS
SET IBBIEN=IEN1
QUIT
+63 IF $GET(PHYS)
IF PHYSX'=PHYS
QUIT
+64 IF $GET(PROC)'=""
SET PROC=$$CODEN^ICPTCOD(PROC)
SET PROCX=$PIECE($GET(^IBBAA(375,IEN1,"PR1")),U,3)
+65 IF +PROC
IF PROCX=PROC
SET IBBIEN=IEN1
QUIT
End DoDot:3
if IBBIEN
QUIT
End DoDot:2
End DoDot:1
+66 ;store external visit #
+67 IF $GET(IBBIEN)
Begin DoDot:1
+68 if ('IBBARFN)
SET IBBARFN=IBBIEN
+69 IF $PIECE(^IBBAA(375,IBBIEN,0),U,2)=""
Begin DoDot:2
+70 SET $PIECE(^IBBAA(375,IBBIEN,0),U,2)=IBBEXVN
+71 SET $PIECE(^IBBAA(375,IBBIEN,0),U,5)=$$NOW^XLFDT()
+72 DO EVENT^IBBAACCT(IBBIEN,IBBEVENT,"I")
End DoDot:2
End DoDot:1
+73 QUIT IBBARFN
+74 ;
INPT() ;set new account record for inpatient admission
+1 NEW IBB,IBBARFN,IBBIEN,IBBIENS,IBBERR,FDA,X
+2 SET IBBARFN=0
+3 LOCK +^IBBAA(375,0):5
+4 if '$TEST
QUIT 0
+5 SET IBBIEN=$PIECE(^IBBAA(375,0),U,3)+1
+6 SET IBBIEN(1)=IBBIEN
+7 SET IBBIENS="+1,"
+8 SET IBBERR="IBB(""DIERR"")"
+9 SET FDA(375,IBBIENS,.01)=IBBIEN
+10 SET FDA(375,IBBIENS,.02)=IBBEXVN
+11 SET FDA(375,IBBIENS,.03)=IBBDFN
+12 SET FDA(375,IBBIENS,.04)="COTS_SYSTEM"
+13 SET FDA(375,IBBIENS,.05)=$$NOW^XLFDT
+14 DO UPDATE^DIE("","FDA","IBBIEN",IBBERR)
+15 LOCK -^IBBAA(375,0)
+16 IF '$DATA(IBB("DIERR"))
Begin DoDot:1
+17 SET IBBARFN=IBBIEN
+18 SET X=""
SET $PIECE(X,U,2)="I"
SET $PIECE(X,U,3)=IBBWHERE
SET $PIECE(X,U,44)=IBBWHEN
+19 SET ^IBBAA(375,IBBIEN,"PV1")=X
+20 DO EVENT^IBBAACCT(IBBIEN,IBBEVENT,"I")
+21 SET ^IBBAA(375,"AC",IBBDFN,IBBWHEN,IBBWHERE,IBBIEN)=""
End DoDot:1
+22 QUIT IBBARFN
+23 ;
INTNUM(IBBEXVN) ;return PFSS Account Reference using external visit number
+1 NEW IBBARFN,XX
+2 SET IBBARFN=""
+3 if '$GET(IBBEXVN)
QUIT IBBARFN
+4 SET XX=$ORDER(^IBBAA(375,"C",IBBEXVN,0))
+5 IF XX
SET IBBARFN=XX
+6 QUIT IBBARFN
+7 ;
PID() ;get DFN from HL7 message; compare to file #2 data
+1 NEW IBBARRY,OUT,REP,FILE,FIELD,IENS,XID,XTYP,XSITE,XSSN,XNAME,XX
+2 SET OUT=0
SET XID=0
SET XSSN=0
+3 FOR
if OUT
QUIT
if '$$NEXTSEG^HLPRS(.IBBMSG,.IBBSEG)
QUIT
IF IBBSEG("SEGMENT TYPE")="PID"
Begin DoDot:1
+4 SET XNAME=$$GET^HLOPRS(.IBBSEG,5,1,1)
+5 FOR REP=1:1
if OUT
QUIT
Begin DoDot:2
+6 SET XTYP=$$GET^HLOPRS(.IBBSEG,3,5,1,REP)
+7 IF XTYP="PI"
Begin DoDot:3
+8 SET XX=$$GET^HLOPRS(.IBBSEG,3,1,1,REP)
+9 SET XSITE=+$EXTRACT(XX,1,3)
SET XID=+$EXTRACT(XX,4,99)
End DoDot:3
+10 IF XTYP="SS"
SET XSSN=$$GET^HLOPRS(.IBBSEG,3,1,1,REP)
+11 IF XID&XSSN
SET OUT=1
End DoDot:2
End DoDot:1
+12 IF XSITE=$PIECE($$SITE^VASITE(),U,3)
Begin DoDot:1
+13 SET FILE=2
SET IENS=XID_","
SET FIELD=".01;.09"
+14 DO GETS^DIQ(FILE,IENS,FIELD,"","IBBARRY")
+15 IF XSSN'=$GET(IBBARRY(2,IENS,.09))
SET XID=0
+16 IF XNAME'=$PIECE($GET(IBBARRY(2,IENS,.01)),",",1)
SET XID=0
End DoDot:1
+17 QUIT XID
+18 ;
EXVN() ;external account/visit number must be non-null
+1 NEW OUT,IBBEXVN
+2 SET IBBEXVN=""
SET OUT=0
+3 FOR
if OUT
QUIT
if '$$NEXTSEG^HLPRS(.IBBMSG,.IBBSEG)
QUIT
Begin DoDot:1
+4 IF IBBSEG("SEGMENT TYPE")="PV1"
Begin DoDot:2
+5 SET IBBEXVN=$$GET^HLOPRS(.IBBSEG,19,1)
SET OUT=1
End DoDot:2
QUIT
End DoDot:1
+6 QUIT IBBEXVN
+7 ;
ACK ; prepare positive acknowledgement (AA) message
+1 NEW HLA,HLRESULT
+2 SET XX=$$SETPURG^HLUTIL(0)
+3 SET HLA("HLA",$JOB,1)="MSA"_HL("FS")_"AA"_HL("FS")_HL("MID")
+4 DO GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.HLRESULT)
+5 QUIT
+6 ;
NAK ;prepare negative acknowledgement (AE) message
+1 NEW HLA,HLRESULT
+2 SET XX=$$SETPURG^HLUTIL(1)
+3 SET HLA("HLA",$JOB,1)="MSA"_HL("FS")_"AE"_HL("FS")_HL("MID")_HL("FS")_HLERR
+4 DO GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.HLRESULT)
+5 QUIT
+6 ;
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
+2 ;input IBBDFN = pointer to file #2
+3 ; IBBTYPE = I(npatient) or O(utpatient)
+4 ; IBBWHEN = date/time of visit; internal FM format
+5 ; IBBWHERE = location of visit; pointer to file #44
+6 ; IBBEXVN = external system visit #
+7 ;output IBBARFN = ien in file #375; PFSS Account Reference
+8 ;
+9 NEW IBB,IBBARFN,IBBIEN,IBBIENS,IBBERR,FDA,X
+10 SET IBBARFN=0
+11 LOCK +^IBBAA(375,0):5
+12 if '$TEST
QUIT 0
+13 SET IBBIEN=$PIECE(^IBBAA(375,0),U,3)+1
+14 SET IBBIEN(1)=IBBIEN
+15 SET IBBIENS="+1,"
+16 SET IBBERR="IBB(""DIERR"")"
+17 SET FDA(375,IBBIENS,.01)=IBBIEN
+18 SET FDA(375,IBBIENS,.02)=$GET(IBBEXVN)
+19 SET FDA(375,IBBIENS,.03)=$GET(IBBDFN)
+20 SET FDA(375,IBBIENS,.04)="CONVERSION"
+21 SET FDA(375,IBBIENS,.05)=$$NOW^XLFDT
+22 DO UPDATE^DIE("","FDA","IBBIEN",IBBERR)
+23 LOCK -^IBBAA(375,0)
+24 IF '$DATA(IBB("DIERR"))
Begin DoDot:1
+25 SET IBBARFN=IBBIEN
+26 SET X=""
SET $PIECE(X,U,2)=$GET(IBBTYPE)
SET $PIECE(X,U,3)=$GET(IBBWHERE)
SET $PIECE(X,U,44)=$GET(IBBWHEN)
+27 SET ^IBBAA(375,IBBIEN,"PV1")=X
+28 IF IBBTYPE="O"
SET $PIECE(^IBBAA(375,IBBIEN,"PV2"),U,8)=$GET(IBBWHEN)
+29 IF $GET(IBBDFN)
IF $GET(IBBWHEN)
IF $GET(IBBWHERE)
SET ^IBBAA(375,"AC",IBBDFN,IBBWHEN,IBBWHERE,IBBIEN)=""
End DoDot:1
+30 QUIT IBBARFN
