MPIFBT2 ;SLC/ARS-BATCH RESPONSE FROM MPI ;FEB 4, 1997
;;1.0; MASTER PATIENT INDEX VISTA ;**1,3,10,17,21,31,43,53**;30 Apr 99;Build 1
;
; Integration Agreements Utilized:
; ^DGCN(391.91 - #2751
; EXC, START, STOP ^RGHLLOG - #2796
; XMITFLAG^VAFCDD01 - #3493
; $$PIVNW^VAFHPIVT - #3494
;
ADDPAT ;Called when response from MPI is received for messages sent.
K ^XTMP($J,"MPIF") D NOW^%DTC S ST=%,X1=ST,X2=20 D C^%DTC
S STP=X,^XTMP($J,"MPIF","MPIIN",0)=STP_"^"_ST_"^"_"MPI BATCH JOB"
K %,X,Y,X1,X2,ST,STP N RGLOG,MPIMSG S MPIMSG=HLMTIEN
D START^RGHLLOG(HLMTIEN,"","ADDPAT^MPIFBT2")
D PREPMSG,PROCESS(MPIMSG),STOP^RGHLLOG(0)
K ACK1,ACK2,ACK3,ACK4,HDR,MPICKG,MPIIN,MPIIPPF,MPIIT,MPINUM,MPIPPF,DA
K CNTR,COM,ENC,ESC,LOCAL,MSHDR,PATID,REP,SCOM,SEP,SITE,MPIDTH,VISTDTH,MPITMP,MPICNTR,MPIFOK,^XTMP($J,"MPIF"),DGSENFLG
Q
PREPMSG ;prepare for response
N I,J,X F I=1:1 X HLNEXT Q:HLQUIT'>0 D
.S ^XTMP($J,"MPIF","MPIIN",I)=HLNODE,J=0
.F S J=$O(HLNODE(J)) Q:'J S ^XTMP($J,"MPIF","MPIIN",I,J)=HLNODE(J)
Q
PROCESS(MPIMSG) ;Process mesage out of array
N HDR,MPICNTR S MPICNTR=1,HDR=^XTMP($J,"MPIF","MPIIN",1) ;check hdr here
D CHDR(HDR,.SEP,MPICNTR,MPIMSG)
Q:$D(^XTMP($J,"MPIF","MSHERR"))
F S MPICNTR=$O(^XTMP($J,"MPIF","MPIIN",MPICNTR)) Q:'MPICNTR D LOOPS(.MPICNTR,SEP,MPIMSG)
Q
LOOPS(CNTR,SEP,MPIMSG) ;Loop in the batch
K ^XTMP($J,"MPIF","MSHERR") N MSHDR,ACK1,ACK2,ACK3,ACK4,ACK5,PATID,LOCAL,MPITMP,LICN
S MSHDR=^XTMP($J,"MPIF","MPIIN",+CNTR)
D CHKMSH(MSHDR,.SITE,SEP,MPIMSG)
Q:$D(^XTMP($J,"MPIF","MSHERR"))
S CNTR=$O(^XTMP($J,"MPIF","MPIIN",CNTR)) Q:CNTR'>0
S ACK1=^XTMP($J,"MPIF","MPIIN",CNTR)
I $P(ACK1,SEP)'="MSA" S ^XTMP($J,"MPIF","MSHERR")="NOT AN MSA SEGMENT" D EXC^RGHLLOG(203,"Around line number "_(CNTR*2)_" of message "_MPIMSG_".")
Q:$D(^XTMP($J,"MPIF","MSHERR"))
I ACK1["AR" S ^XTMP($J,"MPIF","MSHERR")="APP REJECT ERROR" D EXC^RGHLLOG(207,"Around line number "_(CNTR*2)_" of message "_MPIMSG_".")
Q:$D(^XTMP($J,"MPIF","MSHERR"))
I ACK1["AE" S ^XTMP($J,"MPIF","MSHERR")="APP ERROR" D EXC^RGHLLOG(208,"Around line number "_(CNTR*2)_" of message "_MPIMSG_".")
;ACK1 must be an AA
Q:$D(^XTMP($J,"MPIF","MSHERR"))
S CNTR=$O(^XTMP($J,"MPIF","MPIIN",CNTR)) Q:CNTR'>0
S ACK2=^XTMP($J,"MPIF","MPIIN",CNTR)
I $P(ACK2,SEP)'="QAK" S ^XTMP($J,"MPIF","MSHERR")="NOT A QAK SEGMENT" D EXC^RGHLLOG(202,"Around line number "_(CNTR*2)_" of message "_MPIMSG_".")
Q:$D(^XTMP($J,"MPIF","MSHERR"))
I ACK2["NO DATA" D
.S ^XTMP($J,"MPIF","MSHERR")="NO DATA in MPI "
.;**43 NO DATA FOUND TRIGGER ADD
.S MPIFRPC=1 D A28^MPIFQ3($P(ACK2,SEP,2)) K MPIFRPC
.;I ACK2["POTENTIAL MATCHES" D EXC^RGHLLOG(218,"Potential matches found, please review via MPI/PD Exception Handler",$P(ACK2,SEP,2)) ;**53 MPIC_1853 Remove 218 references
.;D EXC^RGHLLOG(218,"For Patient DFN="_$P(ACK2,SEP,2)_". Use Single Patient Initialization to MPI option to manually process.",$P(ACK2,SEP,2))
.;I $D(^DPT($P(ACK2,SEP,2),0)) S LICN=$$ICNLC^MPIF001($P(ACK2,SEP,2))
.; ^ create a local ICN
.;I ACK2'["POTENTIAL MATCHES" D
.;D EXC^RGHLLOG(209,"For Patient DFN="_$P(ACK2,SEP,2)_". Need required fields before patient can be processed again the MPI.",$P(ACK2,SEP,2))
.;I $D(^DPT($P(ACK2,SEP,2),0)) S LICN=$$ICNLC^MPIF001($P(ACK2,SEP,2))
.; ^ create a local ICN
.N TACK,TCNTR S TCNTR=CNTR,CNTR=$O(^XTMP($J,"MPIF","MPIIN",CNTR)),TACK=^XTMP($J,"MPIF","MPIIN",CNTR)
.I $P(TACK,SEP)="MSH" S CNTR=TCNTR
Q:$D(^XTMP($J,"MPIF","MSHERR"))
S PATID=$P(ACK2,SEP,2),LOCAL=$G(^DPT(PATID,0)) ;Verify patient is in database
I LOCAL']"" S ^XTMP($J,"MPIF","MSHERR")="PATIENT DFN NOT IN DATABASE- BAD " D EXC^RGHLLOG(210,"Around line number "_(CNTR*2)_" DFN= "_PATID_" MESSAGE# "_MPIMSG,PATID)
S CNTR=$O(^XTMP($J,"MPIF","MPIIN",CNTR)) Q:CNTR'>0
; **43 MOVED CNTR INCREASE TO GET TO NEXT MSH
Q:$D(^XTMP($J,"MPIF","MSHERR"))
S ACK3=^XTMP($J,"MPIF","MPIIN",CNTR) ;RDF DEFINITION SEGMENT NO-OP
I $P(ACK3,SEP)'="RDF" S ^XTMP($J,"MPIF","MSHERR")="NOT RDF SEGMENT" D EXC^RGHLLOG(204,"Around line number "_(CNTR*2)_" of message "_MPIMSG_".",PATID)
Q:$D(^XTMP($J,"MPIF","MSHERR"))
S CNTR=$O(^XTMP($J,"MPIF","MPIIN",CNTR)) Q:CNTR'>0
S RDTSEQ=1
S ACK4(RDTSEQ)=^XTMP($J,"MPIF","MPIIN",CNTR)
I $P(ACK4(RDTSEQ),SEP)'="RDT" S ^XTMP($J,"MPIF","MSHERR")="NOT RDT SEGMENT" D EXC^RGHLLOG(205,"Around line number "_(CNTR*2)_" of message "_MPIMSG_".",PATID)
;
N RDTSQ S RDTSQ=0
F S RDTSQ=$O(^XTMP($J,"MPIF","MPIIN",CNTR,RDTSQ)) Q:'RDTSQ D
.S ACK4(RDTSEQ+1)=^XTMP($J,"MPIF","MPIIN",CNTR,RDTSQ),RDTSEQ=RDTSEQ+1
Q:$D(^XTMP($J,"MPIF","MSHERR"))
S MPITMP=$O(^XTMP($J,"MPIF","MPIIN",CNTR))
I MPITMP'>0 S:$E($G(^XTMP($J,"MPIF","MPIIN",MPITMP)),1,3)="BTS" CNTR=$O(^XTMP($J,"MPIF","MPIIN",CNTR))
Q:CNTR'>0
D VFYRDT^MPIFBT3(.ACK4,SEP,CNTR,PATID,SITE,MPIMSG)
S MPITMP=$O(^XTMP($J,"MPIF","MPIIN",CNTR))
Q:MPITMP'>0
S ACK5=^XTMP($J,"MPIF","MPIIN",MPITMP)
I $P(ACK5,SEP)="RDT" D MULT^MPIFBT3(.CNTR,ACK5,SEP,MPIMSG,PATID)
K RDTSEQ
Q
TFLIST(TFSITE,PATID) ;adding TFSITE site for patient to Treating Facility List (#391.91)
I $G(TFSITE)="" S ^XTMP($J,"MPIF","MSHERR")="Treating Facility = null" D EXC^RGHLLOG(212,"DFN = "_PATID_" Treating Facility = Null",PATID) Q
S TFSITE=$$LKUP^XUAF4(TFSITE)
Q:+TFSITE'>0
Q:$D(^DGCN(391.91,"APAT",PATID,TFSITE))
K DD,DO N DIC,X,Y L +^DGCN(391.91,0):60
I '$T D EXC^RGHLLOG(212,"Unable to Lock Treating Facility file to add patient DFN="_PATID_" Facility= "_TFSITE,PATID) Q
S DIC="^DGCN(391.91,",DIC("DR")=".02///`"_TFSITE,X=PATID,DIC(0)="LQZ"
I $D(^DGCN(391.91,"APAT",PATID,TFSITE)) L -^DGCN(391.91,0) Q
D FILE^DICN L -^DGCN(391.91,0)
I +Y=-1,'$D(^DGCN(391.91,"APAT",PATID,TFSITE)) S ^XTMP($J,"MPIF","MSHERR")="Treating Facility Add Failed" D EXC^RGHLLOG(212,"DFN= "_PATID_" Treating Facility= "_TFSITE_" failed when adding an entry to the Treating Facility file.",PATID)
K DD,DO,DIC,X,Y
Q
TFUPDT(PATID,MPIMSG,CNTR) ;treating facility update message to pivot file
N ERR,TRANS,EVDT,X,Y,%
D NOW^%DTC S EVDT=% K %,X,Y
S ERR=$$PIVNW^VAFHPIVT(PATID,EVDT,5,PATID_";DPT(")
I +ERR<1 D EXC^RGHLLOG(212,"When trying to add Patient (DFN)"_PATID_" message# "_MPIMSG_" around line number "_(CNTR*2),PATID)
Q:+ERR<1
D XMITFLAG^VAFCDD01("",+ERR)
Q
CHDR(HDR,SEP,CNTR,MPIMSG) ;Only process Batch message responses
I $P(HDR,"^")'="BHS" S ^XTMP($J,"MPIF","MSHERR")="BHS SEGMENT MISSING" D EXC^RGHLLOG(200,"for message "_MPIMSG_". The segment contains "_HDR)
Q:$D(^XTMP($J,"MPIF","MSHERR"))
S SEP=$G(HL("FS")) ;get field sep, and encoding characters
I SEP="" S ^XTMP($J,"MPIF","MSHERR")="Missing field seperator" D EXC^RGHLLOG(200,"Missing field seperator")
Q
CHKMSH(MSHDR,SITE,SEP,MPIMSG) ;VERIFY MSH
I $P(MSHDR,SEP)="BTS" S ^XTMP($J,"MPIF","MSHERR")="BTS FOUND" Q
S:$P(MSHDR,SEP)'="MSH" ^XTMP($J,"MPIF","MSHERR")="NOT MSH HEADER MESSAGE# "_MPIMSG
S:$E(MSHDR,4)'=SEP ^XTMP($J,"MPIF","MSHERR")="FIELD SEPARATOR MISMATCH MESSAGE# "_MPIMSG
I $D(^XTMP($J,"MPIF","MSHERR")) D EXC^RGHLLOG(201,$G(^XTMP($J,"MPIF","MSHERR")))
Q:$D(^XTMP($J,"MPIF","MSHERR"))
S SITE=$P(MSHDR,SEP,6)
I SITE="" S ^XTMP($J,"MPIF","MSHERR")="SITE NOT IN MSH"
I $D(^XTMP($J,"MPIF","MSHERR")) D EXC^RGHLLOG(8,"MSH Doesn't Have SITE as 6th piece. MESSAGE# "_MPIMSG)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMPIFBT2 7305 printed Dec 13, 2024@02:10:58 Page 2
MPIFBT2 ;SLC/ARS-BATCH RESPONSE FROM MPI ;FEB 4, 1997
+1 ;;1.0; MASTER PATIENT INDEX VISTA ;**1,3,10,17,21,31,43,53**;30 Apr 99;Build 1
+2 ;
+3 ; Integration Agreements Utilized:
+4 ; ^DGCN(391.91 - #2751
+5 ; EXC, START, STOP ^RGHLLOG - #2796
+6 ; XMITFLAG^VAFCDD01 - #3493
+7 ; $$PIVNW^VAFHPIVT - #3494
+8 ;
ADDPAT ;Called when response from MPI is received for messages sent.
+1 KILL ^XTMP($JOB,"MPIF")
DO NOW^%DTC
SET ST=%
SET X1=ST
SET X2=20
DO C^%DTC
+2 SET STP=X
SET ^XTMP($JOB,"MPIF","MPIIN",0)=STP_"^"_ST_"^"_"MPI BATCH JOB"
+3 KILL %,X,Y,X1,X2,ST,STP
NEW RGLOG,MPIMSG
SET MPIMSG=HLMTIEN
+4 DO START^RGHLLOG(HLMTIEN,"","ADDPAT^MPIFBT2")
+5 DO PREPMSG
DO PROCESS(MPIMSG)
DO STOP^RGHLLOG(0)
+6 KILL ACK1,ACK2,ACK3,ACK4,HDR,MPICKG,MPIIN,MPIIPPF,MPIIT,MPINUM,MPIPPF,DA
+7 KILL CNTR,COM,ENC,ESC,LOCAL,MSHDR,PATID,REP,SCOM,SEP,SITE,MPIDTH,VISTDTH,MPITMP,MPICNTR,MPIFOK,^XTMP($JOB,"MPIF"),DGSENFLG
+8 QUIT
PREPMSG ;prepare for response
+1 NEW I,J,X
FOR I=1:1
XECUTE HLNEXT
if HLQUIT'>0
QUIT
Begin DoDot:1
+2 SET ^XTMP($JOB,"MPIF","MPIIN",I)=HLNODE
SET J=0
+3 FOR
SET J=$ORDER(HLNODE(J))
if 'J
QUIT
SET ^XTMP($JOB,"MPIF","MPIIN",I,J)=HLNODE(J)
End DoDot:1
+4 QUIT
PROCESS(MPIMSG) ;Process mesage out of array
+1 ;check hdr here
NEW HDR,MPICNTR
SET MPICNTR=1
SET HDR=^XTMP($JOB,"MPIF","MPIIN",1)
+2 DO CHDR(HDR,.SEP,MPICNTR,MPIMSG)
+3 if $DATA(^XTMP($JOB,"MPIF","MSHERR"))
QUIT
+4 FOR
SET MPICNTR=$ORDER(^XTMP($JOB,"MPIF","MPIIN",MPICNTR))
if 'MPICNTR
QUIT
DO LOOPS(.MPICNTR,SEP,MPIMSG)
+5 QUIT
LOOPS(CNTR,SEP,MPIMSG) ;Loop in the batch
+1 KILL ^XTMP($JOB,"MPIF","MSHERR")
NEW MSHDR,ACK1,ACK2,ACK3,ACK4,ACK5,PATID,LOCAL,MPITMP,LICN
+2 SET MSHDR=^XTMP($JOB,"MPIF","MPIIN",+CNTR)
+3 DO CHKMSH(MSHDR,.SITE,SEP,MPIMSG)
+4 if $DATA(^XTMP($JOB,"MPIF","MSHERR"))
QUIT
+5 SET CNTR=$ORDER(^XTMP($JOB,"MPIF","MPIIN",CNTR))
if CNTR'>0
QUIT
+6 SET ACK1=^XTMP($JOB,"MPIF","MPIIN",CNTR)
+7 IF $PIECE(ACK1,SEP)'="MSA"
SET ^XTMP($JOB,"MPIF","MSHERR")="NOT AN MSA SEGMENT"
DO EXC^RGHLLOG(203,"Around line number "_(CNTR*2)_" of message "_MPIMSG_".")
+8 if $DATA(^XTMP($JOB,"MPIF","MSHERR"))
QUIT
+9 IF ACK1["AR"
SET ^XTMP($JOB,"MPIF","MSHERR")="APP REJECT ERROR"
DO EXC^RGHLLOG(207,"Around line number "_(CNTR*2)_" of message "_MPIMSG_".")
+10 if $DATA(^XTMP($JOB,"MPIF","MSHERR"))
QUIT
+11 IF ACK1["AE"
SET ^XTMP($JOB,"MPIF","MSHERR")="APP ERROR"
DO EXC^RGHLLOG(208,"Around line number "_(CNTR*2)_" of message "_MPIMSG_".")
+12 ;ACK1 must be an AA
+13 if $DATA(^XTMP($JOB,"MPIF","MSHERR"))
QUIT
+14 SET CNTR=$ORDER(^XTMP($JOB,"MPIF","MPIIN",CNTR))
if CNTR'>0
QUIT
+15 SET ACK2=^XTMP($JOB,"MPIF","MPIIN",CNTR)
+16 IF $PIECE(ACK2,SEP)'="QAK"
SET ^XTMP($JOB,"MPIF","MSHERR")="NOT A QAK SEGMENT"
DO EXC^RGHLLOG(202,"Around line number "_(CNTR*2)_" of message "_MPIMSG_".")
+17 if $DATA(^XTMP($JOB,"MPIF","MSHERR"))
QUIT
+18 IF ACK2["NO DATA"
Begin DoDot:1
+19 SET ^XTMP($JOB,"MPIF","MSHERR")="NO DATA in MPI "
+20 ;**43 NO DATA FOUND TRIGGER ADD
+21 SET MPIFRPC=1
DO A28^MPIFQ3($PIECE(ACK2,SEP,2))
KILL MPIFRPC
+22 ;I ACK2["POTENTIAL MATCHES" D EXC^RGHLLOG(218,"Potential matches found, please review via MPI/PD Exception Handler",$P(ACK2,SEP,2)) ;**53 MPIC_1853 Remove 218 references
+23 ;D EXC^RGHLLOG(218,"For Patient DFN="_$P(ACK2,SEP,2)_". Use Single Patient Initialization to MPI option to manually process.",$P(ACK2,SEP,2))
+24 ;I $D(^DPT($P(ACK2,SEP,2),0)) S LICN=$$ICNLC^MPIF001($P(ACK2,SEP,2))
+25 ; ^ create a local ICN
+26 ;I ACK2'["POTENTIAL MATCHES" D
+27 ;D EXC^RGHLLOG(209,"For Patient DFN="_$P(ACK2,SEP,2)_". Need required fields before patient can be processed again the MPI.",$P(ACK2,SEP,2))
+28 ;I $D(^DPT($P(ACK2,SEP,2),0)) S LICN=$$ICNLC^MPIF001($P(ACK2,SEP,2))
+29 ; ^ create a local ICN
+30 NEW TACK,TCNTR
SET TCNTR=CNTR
SET CNTR=$ORDER(^XTMP($JOB,"MPIF","MPIIN",CNTR))
SET TACK=^XTMP($JOB,"MPIF","MPIIN",CNTR)
+31 IF $PIECE(TACK,SEP)="MSH"
SET CNTR=TCNTR
End DoDot:1
+32 if $DATA(^XTMP($JOB,"MPIF","MSHERR"))
QUIT
+33 ;Verify patient is in database
SET PATID=$PIECE(ACK2,SEP,2)
SET LOCAL=$GET(^DPT(PATID,0))
+34 IF LOCAL']""
SET ^XTMP($JOB,"MPIF","MSHERR")="PATIENT DFN NOT IN DATABASE- BAD "
DO EXC^RGHLLOG(210,"Around line number "_(CNTR*2)_" DFN= "_PATID_" MESSAGE# "_MPIMSG,PATID)
+35 SET CNTR=$ORDER(^XTMP($JOB,"MPIF","MPIIN",CNTR))
if CNTR'>0
QUIT
+36 ; **43 MOVED CNTR INCREASE TO GET TO NEXT MSH
+37 if $DATA(^XTMP($JOB,"MPIF","MSHERR"))
QUIT
+38 ;RDF DEFINITION SEGMENT NO-OP
SET ACK3=^XTMP($JOB,"MPIF","MPIIN",CNTR)
+39 IF $PIECE(ACK3,SEP)'="RDF"
SET ^XTMP($JOB,"MPIF","MSHERR")="NOT RDF SEGMENT"
DO EXC^RGHLLOG(204,"Around line number "_(CNTR*2)_" of message "_MPIMSG_".",PATID)
+40 if $DATA(^XTMP($JOB,"MPIF","MSHERR"))
QUIT
+41 SET CNTR=$ORDER(^XTMP($JOB,"MPIF","MPIIN",CNTR))
if CNTR'>0
QUIT
+42 SET RDTSEQ=1
+43 SET ACK4(RDTSEQ)=^XTMP($JOB,"MPIF","MPIIN",CNTR)
+44 IF $PIECE(ACK4(RDTSEQ),SEP)'="RDT"
SET ^XTMP($JOB,"MPIF","MSHERR")="NOT RDT SEGMENT"
DO EXC^RGHLLOG(205,"Around line number "_(CNTR*2)_" of message "_MPIMSG_".",PATID)
+45 ;
+46 NEW RDTSQ
SET RDTSQ=0
+47 FOR
SET RDTSQ=$ORDER(^XTMP($JOB,"MPIF","MPIIN",CNTR,RDTSQ))
if 'RDTSQ
QUIT
Begin DoDot:1
+48 SET ACK4(RDTSEQ+1)=^XTMP($JOB,"MPIF","MPIIN",CNTR,RDTSQ)
SET RDTSEQ=RDTSEQ+1
End DoDot:1
+49 if $DATA(^XTMP($JOB,"MPIF","MSHERR"))
QUIT
+50 SET MPITMP=$ORDER(^XTMP($JOB,"MPIF","MPIIN",CNTR))
+51 IF MPITMP'>0
if $EXTRACT($GET(^XTMP($JOB,"MPIF","MPIIN",MPITMP)),1,3)="BTS"
SET CNTR=$ORDER(^XTMP($JOB,"MPIF","MPIIN",CNTR))
+52 if CNTR'>0
QUIT
+53 DO VFYRDT^MPIFBT3(.ACK4,SEP,CNTR,PATID,SITE,MPIMSG)
+54 SET MPITMP=$ORDER(^XTMP($JOB,"MPIF","MPIIN",CNTR))
+55 if MPITMP'>0
QUIT
+56 SET ACK5=^XTMP($JOB,"MPIF","MPIIN",MPITMP)
+57 IF $PIECE(ACK5,SEP)="RDT"
DO MULT^MPIFBT3(.CNTR,ACK5,SEP,MPIMSG,PATID)
+58 KILL RDTSEQ
+59 QUIT
TFLIST(TFSITE,PATID) ;adding TFSITE site for patient to Treating Facility List (#391.91)
+1 IF $GET(TFSITE)=""
SET ^XTMP($JOB,"MPIF","MSHERR")="Treating Facility = null"
DO EXC^RGHLLOG(212,"DFN = "_PATID_" Treating Facility = Null",PATID)
QUIT
+2 SET TFSITE=$$LKUP^XUAF4(TFSITE)
+3 if +TFSITE'>0
QUIT
+4 if $DATA(^DGCN(391.91,"APAT",PATID,TFSITE))
QUIT
+5 KILL DD,DO
NEW DIC,X,Y
LOCK +^DGCN(391.91,0):60
+6 IF '$TEST
DO EXC^RGHLLOG(212,"Unable to Lock Treating Facility file to add patient DFN="_PATID_" Facility= "_TFSITE,PATID)
QUIT
+7 SET DIC="^DGCN(391.91,"
SET DIC("DR")=".02///`"_TFSITE
SET X=PATID
SET DIC(0)="LQZ"
+8 IF $DATA(^DGCN(391.91,"APAT",PATID,TFSITE))
LOCK -^DGCN(391.91,0)
QUIT
+9 DO FILE^DICN
LOCK -^DGCN(391.91,0)
+10 IF +Y=-1
IF '$DATA(^DGCN(391.91,"APAT",PATID,TFSITE))
SET ^XTMP($JOB,"MPIF","MSHERR")="Treating Facility Add Failed"
DO EXC^RGHLLOG(212,"DFN= "_PATID_" Treating Facility= "_TFSITE_" failed when adding an entry to the Treating Facility file.",PATID)
+11 KILL DD,DO,DIC,X,Y
+12 QUIT
TFUPDT(PATID,MPIMSG,CNTR) ;treating facility update message to pivot file
+1 NEW ERR,TRANS,EVDT,X,Y,%
+2 DO NOW^%DTC
SET EVDT=%
KILL %,X,Y
+3 SET ERR=$$PIVNW^VAFHPIVT(PATID,EVDT,5,PATID_";DPT(")
+4 IF +ERR<1
DO EXC^RGHLLOG(212,"When trying to add Patient (DFN)"_PATID_" message# "_MPIMSG_" around line number "_(CNTR*2),PATID)
+5 if +ERR<1
QUIT
+6 DO XMITFLAG^VAFCDD01("",+ERR)
+7 QUIT
CHDR(HDR,SEP,CNTR,MPIMSG) ;Only process Batch message responses
+1 IF $PIECE(HDR,"^")'="BHS"
SET ^XTMP($JOB,"MPIF","MSHERR")="BHS SEGMENT MISSING"
DO EXC^RGHLLOG(200,"for message "_MPIMSG_". The segment contains "_HDR)
+2 if $DATA(^XTMP($JOB,"MPIF","MSHERR"))
QUIT
+3 ;get field sep, and encoding characters
SET SEP=$GET(HL("FS"))
+4 IF SEP=""
SET ^XTMP($JOB,"MPIF","MSHERR")="Missing field seperator"
DO EXC^RGHLLOG(200,"Missing field seperator")
+5 QUIT
CHKMSH(MSHDR,SITE,SEP,MPIMSG) ;VERIFY MSH
+1 IF $PIECE(MSHDR,SEP)="BTS"
SET ^XTMP($JOB,"MPIF","MSHERR")="BTS FOUND"
QUIT
+2 if $PIECE(MSHDR,SEP)'="MSH"
SET ^XTMP($JOB,"MPIF","MSHERR")="NOT MSH HEADER MESSAGE# "_MPIMSG
+3 if $EXTRACT(MSHDR,4)'=SEP
SET ^XTMP($JOB,"MPIF","MSHERR")="FIELD SEPARATOR MISMATCH MESSAGE# "_MPIMSG
+4 IF $DATA(^XTMP($JOB,"MPIF","MSHERR"))
DO EXC^RGHLLOG(201,$GET(^XTMP($JOB,"MPIF","MSHERR")))
+5 if $DATA(^XTMP($JOB,"MPIF","MSHERR"))
QUIT
+6 SET SITE=$PIECE(MSHDR,SEP,6)
+7 IF SITE=""
SET ^XTMP($JOB,"MPIF","MSHERR")="SITE NOT IN MSH"
+8 IF $DATA(^XTMP($JOB,"MPIF","MSHERR"))
DO EXC^RGHLLOG(8,"MSH Doesn't Have SITE as 6th piece. MESSAGE# "_MPIMSG)
+9 QUIT
