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

MPIFA24B.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; Integration Agreements Utilized:
  1. ; START, EXC, STOP^RGHLLOG - #2796
  1. ; BLDEVN, BLDPD1, BLDPID^VAFCQRY - #3630
  1. ;
  1. 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
  1. ; **51 ADDED NOA31 as a parameter to stop the sending of an A31 if set to 1
  1. N RESLT,CNT,MPI,EVN,TCNT,ERR,PD1,PID
  1. K HLA("HLA"),HLA("HLS")
  1. S CNT=1
  1. D INIT^HLFNC2("MPIF ADT-A24 SERVER",.HL)
  1. I $O(HL(""))="" Q "-1^"_$P(HL,"^",2)
  1. S HLECH=HL("ECH"),HLFS=HL("FS"),COMP=$E(HL("ECH"),1),REP=$E(HL("ECH"),2),SUBCOMP=$E(HL("ECH"),4)
  1. S ERR="",TCNT=0
  1. D BLDEVN^VAFCQRY(DFN,"1,2",.EVN,.HL,"A24",.ERR)
  1. Q:ERR'="" ERR
  1. D BLDPID^VAFCQRY(DFN,1,"ALL",.PID,.HL,.ERR)
  1. Q:ERR'="" ERR
  1. D BLDPD1^VAFCQRY(DFN,"3",.PD1,.HL,.ERR)
  1. Q:ERR'="" ERR
  1. I '$D(PID2) D BLDPID^VAFCQRY(DFN,2,"ALL",.PID2,.HL,.ERR) ;**43 TO ONLY BUILD 2ND PID SEGMENT IF NOT PASSED
  1. Q:ERR'="" ERR
  1. S HLA("HLS",1)=EVN(1)
  1. S HLA("HLS",3)=PD1(1)
  1. S CNT=0 F S CNT=$O(PID(CNT)) Q:CNT="" D
  1. .I CNT=1 S HLA("HLS",2)=PID(CNT)
  1. .I CNT>1 S HLA("HLS",2,CNT-1)=PID(CNT)
  1. S CNT=0 F S CNT=$O(PID2(CNT)) Q:CNT="" D
  1. .I CNT=1 S HLA("HLS",4)=PID2(CNT)
  1. .I CNT>1 S HLA("HLS",4,CNT-1)=PID2(CNT)
  1. S HLA("HLS",5)=$$EN1^VAFHLZPD(DFN,"1,17,21,34") ;25 ;**44 Adding Pseudo SSN Reason, 1 and 21 to ZPD segment
  1. K HLL("LINKS")
  1. D GENERATE^HLMA("MPIF ADT-A24 SERVER","LM",1,.MPIFRSLT,"","")
  1. S RESLT=$S(+MPIFRSLT:MPIFRSLT,1:"-1^"_$P(MPIFRSLT,"^",3)) ;**68 Story 827754 (jfw) - Make Error Data Consistent (-1^msg)
  1. ;**68 Story 827754 (jfw) - Check for value < 0 instead of '+RESLT
  1. 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"
  1. K HLA,HLEID,HLL("LINKS"),COMP,REP,SUBCOMP,HLECH,HLFS,HLA("HLA"),HLA("HLS"),MPIFRSLT
  1. ;**44 TRIGGER A31 TO UPDATE ANY DEMOGRAPHIC CHANGES
  1. ;**51 IF NOT SENDING A31 STOP PROCESSING
  1. I $G(NOA31)=1 Q RESLT
  1. N A31 S A31=$$A31^MPIFA31B(DFN)
  1. I +A31<0 D
  1. .;log exception about A31 not being sent
  1. .D START^RGHLLOG()
  1. .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
  1. .D STOP^RGHLLOG(0)
  1. ;68, Story 827754 (jfw) - Remove redundancy as previously set in MPIFA31B.
  1. ;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"
  1. Q RESLT
  1. ;
  1. RT ;
  1. S MPI=$$MPILINK^MPIFAPI()
  1. I $P($G(MPI),"^")=-1 D START^RGHLLOG(),EXC^RGHLLOG(224,"No logical link defined for the MPI",$G(DFN)),STOP^RGHLLOG() Q
  1. ;**75 - Story - 1260465 (ckn) - Include 200M in HLL links for HAC
  1. S HLL("LINKS",1)="MPIF ADT-A24 CLIENT^"_MPI_$S($P($$SITE^VASITE(),"^",3)=741:"^200M",1:"")
  1. Q
  1. RES ;
  1. N NXT,DFN
  1. F NXT=1:1 X HLNEXT Q:HLQUIT'>0 D
  1. .I $E(HLNODE,1,3)="MSA" S DFN=$P($P(HLNODE,HL("FS"),7),"=",2)
  1. .I $E(HLNODE,1,3)="MSA"&($P(HLNODE,HL("FS"),4)'="") D
  1. ..; ERROR RETURNED IN MSA - LOG EXCEPTION --**44 stopped logging exception as MPI has already logged it.
  1. ..;D START^RGHLLOG(HLMTIEN,"","")
  1. ..;D EXC^RGHLLOG(208,$P(HLNODE,HL("FS"),4)_" for HL msg# "_HLMTIEN,DFN)
  1. ..;D STOP^RGHLLOG(0)
  1. K ^XTMP("MPIFA24%"_DFN)
  1. ;**61 Story 181213 (elz) let DG know A24 done
  1. K ^XTMP("DPTLK7 A24 IN-PROCESS",DFN)
  1. Q