| 1 | MPIFA40 ;BP/CMC-BUILD A40 MERGE MESSAGE ;25 MARCH 2002
|
|---|
| 2 | ;;1.0; MASTER PATIENT INDEX VISTA ;**22,41**;30 Apr 99
|
|---|
| 3 | ;
|
|---|
| 4 | ; Integration Agreements Utilized:
|
|---|
| 5 | ; START, EXC, STOP^RGHLLOG - #2796
|
|---|
| 6 | ; BLDEVN, BLDPD1, BLDPID^VAFCQRY - #3630
|
|---|
| 7 | ;
|
|---|
| 8 | A40(DFN,DFN2) ;BUILD AND SEND A40
|
|---|
| 9 | N PID,PD1,EVN,PD1,MRG,MPI,RESLT,CNT,ICN1,ICN2
|
|---|
| 10 | D INIT^HLFNC2("MPIF ADT-A40 SERVER",.HL)
|
|---|
| 11 | I $O(HL(""))="" Q "-1^"_$P(HL,"^",2)
|
|---|
| 12 | S HLECH=HL("ECH"),HLFS=HL("FS"),COMP=$E(HL("ECH"),1),REP=$E(HL("ECH"),2),SUBCOMP=$E(HL("ECH"),4)
|
|---|
| 13 | S ERR=""
|
|---|
| 14 | D BLDEVN^VAFCQRY(DFN,"1,2",.EVN,.HL,"A40",.ERR)
|
|---|
| 15 | Q:ERR'="" ERR
|
|---|
| 16 | D BLDPID^VAFCQRY(DFN,1,"ALL",.PID,.HL,.ERR) ;**41
|
|---|
| 17 | Q:ERR'="" ERR
|
|---|
| 18 | D BLDPD1^VAFCQRY(DFN,"3",.PD1,.HL,.ERR)
|
|---|
| 19 | Q:ERR'="" ERR
|
|---|
| 20 | D BLDMRG(DFN2,"1,7",.MRG,.HL,.ERR)
|
|---|
| 21 | S HLA("HLS",1)=EVN(1)
|
|---|
| 22 | S HLA("HLS",3)=PD1(1)
|
|---|
| 23 | S HLA("HLS",4)=MRG
|
|---|
| 24 | S CNT=0 F S CNT=$O(PID(CNT)) Q:CNT="" D
|
|---|
| 25 | .I CNT=1 S HLA("HLS",2)=PID(CNT)
|
|---|
| 26 | .I CNT>1 S HLA("HLS",2,CNT-1)=PID(CNT)
|
|---|
| 27 | S MPI=$$MPILINK^MPIFAPI()
|
|---|
| 28 | Q:$P($G(MPI),"^")=-1 "-1^No logical link defined for the MPI"
|
|---|
| 29 | S HLL("LINKS",1)="MPIF ADT-A40 CLIENT^"_MPI
|
|---|
| 30 | D GENERATE^HLMA("MPIF ADT-A40 SERVER","LM",1,.MPIFRSLT,"","") ;**41
|
|---|
| 31 | S RESLT=$S(+MPIFRSLT:MPIFRSLT,1:$P(MPIFRSLT,"^",3))
|
|---|
| 32 | S ^XTMP("MPIFA40%"_DFN,0)=$$FMADD^XLFDT(DT,5)_"^"_DT_"^"_"MPIA40 msg to MPI for DFN "_DFN
|
|---|
| 33 | I +RESLT D
|
|---|
| 34 | .S ICN1=$$GETICN^MPIF001(DFN),ICN2=$$GETICN^MPIF001(DFN2)
|
|---|
| 35 | .S ^XTMP("MPIFA40%"_DFN,DFN2,"MPI",0)="A"
|
|---|
| 36 | .S ^XTMP("MPIFA40%"_DFN,DFN2,"MPI",1)=ICN1_"^"_ICN2_"^"_RESLT
|
|---|
| 37 | K HLA,HLEID,HLL("LINKS"),COMP,REP,SUBCOMP,HLECH,HLFS,HLA("HLA"),HLA("HLS"),MPIFRSLT ;**41
|
|---|
| 38 | Q RESLT
|
|---|
| 39 | ;
|
|---|
| 40 | RES ;
|
|---|
| 41 | N NXT
|
|---|
| 42 | F NXT=1:1 X HLNEXT Q:HLQUIT'>0 D
|
|---|
| 43 | .I $E(HLNODE,1,3)="MSA" S DFN=$P($P(HLNODE,HL("FS"),7),"=",2)
|
|---|
| 44 | .I $E(HLNODE,1,3)="MSA"&($P(HLNODE,HL("FS"),4)'="") D
|
|---|
| 45 | ..; ERROR RETURNED IN MSA - LOG EXCEPTION
|
|---|
| 46 | ..D START^RGHLLOG(HLMTIEN,"","")
|
|---|
| 47 | ..D EXC^RGHLLOG(208,$P(HLNODE,HL("FS"),4)_" for HL msg# "_HLMTIEN,DFN)
|
|---|
| 48 | ..D STOP^RGHLLOG(0)
|
|---|
| 49 | K ^XTMP("MPIFA40%"_DFN)
|
|---|
| 50 | Q
|
|---|
| 51 | ;
|
|---|
| 52 | BLDMRG(IEN,FLD,SEG,HL,ERR) ; bld MRG segment ONLY FIELDS 2 AND 8 SUPPORTED
|
|---|
| 53 | N NODE,MPIZN,MG,X,COMP,SUBCOMP,REP,NAME,ICN,SITE
|
|---|
| 54 | S COMP=$E(HL("ECH"),1),SUBCOMP=$E(HL("ECH"),4),REP=$E(HL("ECH"),2)
|
|---|
| 55 | S MPIZN=$D(^DPT(IEN,0))
|
|---|
| 56 | I MPIZN="" S ERR="-1^No such DFN entry "_IEN Q
|
|---|
| 57 | S SEG="MRG"
|
|---|
| 58 | ;repeat prior ID's including ICN and DFN
|
|---|
| 59 | S NODE=$$MPINODE^MPIFAPI(IEN)
|
|---|
| 60 | S ICN=$P(NODE,"^",1)_"V"_$P(NODE,"^",2),SITE=$P($$SITE^VASITE(),"^",3)
|
|---|
| 61 | S MG(2)=ICN_COMP_COMP_COMP_"USVHA"_SUBCOMP_SUBCOMP_"0363"_COMP_"NI"_COMP_"VA FACILITY ID"_SUBCOMP_SITE_SUBCOMP_"L"_REP_IEN_COMP_COMP_COMP_"USVHA"_SUBCOMP_SUBCOMP_"0363"_COMP_"PI"_COMP_"VA FACILITY ID"_SUBCOMP_SITE_SUBCOMP_"L" ;**41
|
|---|
| 62 | ;NAME
|
|---|
| 63 | S NAME("FILE")=2,NAME("IENS")=IEN,NAME("FIELD")=.01
|
|---|
| 64 | S MG(8)=$$HLNAME^XLFNAME(.NAME,"",COMP)
|
|---|
| 65 | S $P(MG(8),COMP,7)="L"
|
|---|
| 66 | S $P(SEG,HL("FS"),2)=MG(2)
|
|---|
| 67 | S $P(SEG,HL("FS"),8)=MG(8)
|
|---|
| 68 | Q
|
|---|
