MPIFA24B ;BP/CMC-BUILD A24 ADD ME MSGS ; 5/4/20 10:59am
;;1.0;MASTER PATIENT INDEX VISTA;**22,28,31,25,43,44,51,61,68,75**;30 Apr 99;Build 1
;
; Integration Agreements Utilized:
; START, EXC, STOP^RGHLLOG - #2796
; BLDEVN, BLDPD1, BLDPID^VAFCQRY - #3630
;
A24(DFN,PID2,NOA31) ;BUILD AND SEND A24 **43 added PID2 as a parameter - not required.
; if PID2 is defined it will contain the previous ICN data, passed by reference
; **51 ADDED NOA31 as a parameter to stop the sending of an A31 if set to 1
N RESLT,CNT,MPI,EVN,TCNT,ERR,PD1,PID
K HLA("HLA"),HLA("HLS")
S CNT=1
D INIT^HLFNC2("MPIF ADT-A24 SERVER",.HL)
I $O(HL(""))="" Q "-1^"_$P(HL,"^",2)
S HLECH=HL("ECH"),HLFS=HL("FS"),COMP=$E(HL("ECH"),1),REP=$E(HL("ECH"),2),SUBCOMP=$E(HL("ECH"),4)
S ERR="",TCNT=0
D BLDEVN^VAFCQRY(DFN,"1,2",.EVN,.HL,"A24",.ERR)
Q:ERR'="" ERR
D BLDPID^VAFCQRY(DFN,1,"ALL",.PID,.HL,.ERR)
Q:ERR'="" ERR
D BLDPD1^VAFCQRY(DFN,"3",.PD1,.HL,.ERR)
Q:ERR'="" ERR
I '$D(PID2) D BLDPID^VAFCQRY(DFN,2,"ALL",.PID2,.HL,.ERR) ;**43 TO ONLY BUILD 2ND PID SEGMENT IF NOT PASSED
Q:ERR'="" ERR
S HLA("HLS",1)=EVN(1)
S HLA("HLS",3)=PD1(1)
S CNT=0 F S CNT=$O(PID(CNT)) Q:CNT="" D
.I CNT=1 S HLA("HLS",2)=PID(CNT)
.I CNT>1 S HLA("HLS",2,CNT-1)=PID(CNT)
S CNT=0 F S CNT=$O(PID2(CNT)) Q:CNT="" D
.I CNT=1 S HLA("HLS",4)=PID2(CNT)
.I CNT>1 S HLA("HLS",4,CNT-1)=PID2(CNT)
S HLA("HLS",5)=$$EN1^VAFHLZPD(DFN,"1,17,21,34") ;25 ;**44 Adding Pseudo SSN Reason, 1 and 21 to ZPD segment
K HLL("LINKS")
D GENERATE^HLMA("MPIF ADT-A24 SERVER","LM",1,.MPIFRSLT,"","")
S RESLT=$S(+MPIFRSLT:MPIFRSLT,1:"-1^"_$P(MPIFRSLT,"^",3)) ;**68 Story 827754 (jfw) - Make Error Data Consistent (-1^msg)
;**68 Story 827754 (jfw) - Check for value < 0 instead of '+RESLT
I +RESLT<0 S ^XTMP("MPIFA24%"_DFN,0)=$$FMADD^XLFDT(DT,5)_"^"_DT_"^"_"A24 message to MPI for DFN "_DFN,^XTMP("MPIFA24%"_DFN,"MPI",0)="A"
K HLA,HLEID,HLL("LINKS"),COMP,REP,SUBCOMP,HLECH,HLFS,HLA("HLA"),HLA("HLS"),MPIFRSLT
;**44 TRIGGER A31 TO UPDATE ANY DEMOGRAPHIC CHANGES
;**51 IF NOT SENDING A31 STOP PROCESSING
I $G(NOA31)=1 Q RESLT
N A31 S A31=$$A31^MPIFA31B(DFN)
I +A31<0 D
.;log exception about A31 not being sent
.D START^RGHLLOG()
.D EXC^RGHLLOG(208,$P(A31,"^",2)_" : Unable to generate A31 for DFN "_DFN,DFN) ;68, Story 827754 (jfw) - Combine error msgs as 1 param
.D STOP^RGHLLOG(0)
;68, Story 827754 (jfw) - Remove redundancy as previously set in MPIFA31B.
;I $P(A31,"^",2)="" S ^XTMP("MPIFA31%"_DFN,0)=$$FMADD^XLFDT(DT,5)_"^"_DT_"^"_"A31 message to MPI for DFN "_DFN,^XTMP("MPIFA31%"_DFN,"MPI",0)="A"
Q RESLT
;
RT ;
S MPI=$$MPILINK^MPIFAPI()
I $P($G(MPI),"^")=-1 D START^RGHLLOG(),EXC^RGHLLOG(224,"No logical link defined for the MPI",$G(DFN)),STOP^RGHLLOG() Q
;**75 - Story - 1260465 (ckn) - Include 200M in HLL links for HAC
S HLL("LINKS",1)="MPIF ADT-A24 CLIENT^"_MPI_$S($P($$SITE^VASITE(),"^",3)=741:"^200M",1:"")
Q
RES ;
N NXT,DFN
F NXT=1:1 X HLNEXT Q:HLQUIT'>0 D
.I $E(HLNODE,1,3)="MSA" S DFN=$P($P(HLNODE,HL("FS"),7),"=",2)
.I $E(HLNODE,1,3)="MSA"&($P(HLNODE,HL("FS"),4)'="") D
..; ERROR RETURNED IN MSA - LOG EXCEPTION --**44 stopped logging exception as MPI has already logged it.
..;D START^RGHLLOG(HLMTIEN,"","")
..;D EXC^RGHLLOG(208,$P(HLNODE,HL("FS"),4)_" for HL msg# "_HLMTIEN,DFN)
..;D STOP^RGHLLOG(0)
K ^XTMP("MPIFA24%"_DFN)
;**61 Story 181213 (elz) let DG know A24 done
K ^XTMP("DPTLK7 A24 IN-PROCESS",DFN)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMPIFA24B 3483 printed Oct 16, 2024@18:11:30 Page 2
MPIFA24B ;BP/CMC-BUILD A24 ADD ME MSGS ; 5/4/20 10:59am
+1 ;;1.0;MASTER PATIENT INDEX VISTA;**22,28,31,25,43,44,51,61,68,75**;30 Apr 99;Build 1
+2 ;
+3 ; Integration Agreements Utilized:
+4 ; START, EXC, STOP^RGHLLOG - #2796
+5 ; BLDEVN, BLDPD1, BLDPID^VAFCQRY - #3630
+6 ;
A24(DFN,PID2,NOA31) ;BUILD AND SEND A24 **43 added PID2 as a parameter - not required.
+1 ; if PID2 is defined it will contain the previous ICN data, passed by reference
+2 ; **51 ADDED NOA31 as a parameter to stop the sending of an A31 if set to 1
+3 NEW RESLT,CNT,MPI,EVN,TCNT,ERR,PD1,PID
+4 KILL HLA("HLA"),HLA("HLS")
+5 SET CNT=1
+6 DO INIT^HLFNC2("MPIF ADT-A24 SERVER",.HL)
+7 IF $ORDER(HL(""))=""
QUIT "-1^"_$PIECE(HL,"^",2)
+8 SET HLECH=HL("ECH")
SET HLFS=HL("FS")
SET COMP=$EXTRACT(HL("ECH"),1)
SET REP=$EXTRACT(HL("ECH"),2)
SET SUBCOMP=$EXTRACT(HL("ECH"),4)
+9 SET ERR=""
SET TCNT=0
+10 DO BLDEVN^VAFCQRY(DFN,"1,2",.EVN,.HL,"A24",.ERR)
+11 if ERR'=""
QUIT ERR
+12 DO BLDPID^VAFCQRY(DFN,1,"ALL",.PID,.HL,.ERR)
+13 if ERR'=""
QUIT ERR
+14 DO BLDPD1^VAFCQRY(DFN,"3",.PD1,.HL,.ERR)
+15 if ERR'=""
QUIT ERR
+16 ;**43 TO ONLY BUILD 2ND PID SEGMENT IF NOT PASSED
IF '$DATA(PID2)
DO BLDPID^VAFCQRY(DFN,2,"ALL",.PID2,.HL,.ERR)
+17 if ERR'=""
QUIT ERR
+18 SET HLA("HLS",1)=EVN(1)
+19 SET HLA("HLS",3)=PD1(1)
+20 SET CNT=0
FOR
SET CNT=$ORDER(PID(CNT))
if CNT=""
QUIT
Begin DoDot:1
+21 IF CNT=1
SET HLA("HLS",2)=PID(CNT)
+22 IF CNT>1
SET HLA("HLS",2,CNT-1)=PID(CNT)
End DoDot:1
+23 SET CNT=0
FOR
SET CNT=$ORDER(PID2(CNT))
if CNT=""
QUIT
Begin DoDot:1
+24 IF CNT=1
SET HLA("HLS",4)=PID2(CNT)
+25 IF CNT>1
SET HLA("HLS",4,CNT-1)=PID2(CNT)
End DoDot:1
+26 ;25 ;**44 Adding Pseudo SSN Reason, 1 and 21 to ZPD segment
SET HLA("HLS",5)=$$EN1^VAFHLZPD(DFN,"1,17,21,34")
+27 KILL HLL("LINKS")
+28 DO GENERATE^HLMA("MPIF ADT-A24 SERVER","LM",1,.MPIFRSLT,"","")
+29 ;**68 Story 827754 (jfw) - Make Error Data Consistent (-1^msg)
SET RESLT=$SELECT(+MPIFRSLT:MPIFRSLT,1:"-1^"_$PIECE(MPIFRSLT,"^",3))
+30 ;**68 Story 827754 (jfw) - Check for value < 0 instead of '+RESLT
+31 IF +RESLT<0
SET ^XTMP("MPIFA24%"_DFN,0)=$$FMADD^XLFDT(DT,5)_"^"_DT_"^"_"A24 message to MPI for DFN "_DFN
SET ^XTMP("MPIFA24%"_DFN,"MPI",0)="A"
+32 KILL HLA,HLEID,HLL("LINKS"),COMP,REP,SUBCOMP,HLECH,HLFS,HLA("HLA"),HLA("HLS"),MPIFRSLT
+33 ;**44 TRIGGER A31 TO UPDATE ANY DEMOGRAPHIC CHANGES
+34 ;**51 IF NOT SENDING A31 STOP PROCESSING
+35 IF $GET(NOA31)=1
QUIT RESLT
+36 NEW A31
SET A31=$$A31^MPIFA31B(DFN)
+37 IF +A31<0
Begin DoDot:1
+38 ;log exception about A31 not being sent
+39 DO START^RGHLLOG()
+40 ;68, Story 827754 (jfw) - Combine error msgs as 1 param
DO EXC^RGHLLOG(208,$PIECE(A31,"^",2)_" : Unable to generate A31 for DFN "_DFN,DFN)
+41 DO STOP^RGHLLOG(0)
End DoDot:1
+42 ;68, Story 827754 (jfw) - Remove redundancy as previously set in MPIFA31B.
+43 ;I $P(A31,"^",2)="" S ^XTMP("MPIFA31%"_DFN,0)=$$FMADD^XLFDT(DT,5)_"^"_DT_"^"_"A31 message to MPI for DFN "_DFN,^XTMP("MPIFA31%"_DFN,"MPI",0)="A"
+44 QUIT RESLT
+45 ;
RT ;
+1 SET MPI=$$MPILINK^MPIFAPI()
+2 IF $PIECE($GET(MPI),"^")=-1
DO START^RGHLLOG()
DO EXC^RGHLLOG(224,"No logical link defined for the MPI",$GET(DFN))
DO STOP^RGHLLOG()
QUIT
+3 ;**75 - Story - 1260465 (ckn) - Include 200M in HLL links for HAC
+4 SET HLL("LINKS",1)="MPIF ADT-A24 CLIENT^"_MPI_$SELECT($PIECE($$SITE^VASITE(),"^",3)=741:"^200M",1:"")
+5 QUIT
RES ;
+1 NEW NXT,DFN
+2 FOR NXT=1:1
XECUTE HLNEXT
if HLQUIT'>0
QUIT
Begin DoDot:1
+3 IF $EXTRACT(HLNODE,1,3)="MSA"
SET DFN=$PIECE($PIECE(HLNODE,HL("FS"),7),"=",2)
+4 IF $EXTRACT(HLNODE,1,3)="MSA"&($PIECE(HLNODE,HL("FS"),4)'="")
Begin DoDot:2
+5 ; ERROR RETURNED IN MSA - LOG EXCEPTION --**44 stopped logging exception as MPI has already logged it.
+6 ;D START^RGHLLOG(HLMTIEN,"","")
+7 ;D EXC^RGHLLOG(208,$P(HLNODE,HL("FS"),4)_" for HL msg# "_HLMTIEN,DFN)
+8 ;D STOP^RGHLLOG(0)
End DoDot:2
End DoDot:1
+9 KILL ^XTMP("MPIFA24%"_DFN)
+10 ;**61 Story 181213 (elz) let DG know A24 done
+11 KILL ^XTMP("DPTLK7 A24 IN-PROCESS",DFN)
+12 QUIT
