- MPIFA24 ;BPOFO/CMC-A24 PROCESSING ROUTINE ; 5/4/20 10:58am
- ;;1.0;MASTER PATIENT INDEX VISTA;**22,24,27,31,25,41,39,48,52,59,75**;30 Apr 99;Build 1
- ;
- ; Integration Agreements Utilized:
- ; START, EXC, STOP^RGHLLOG - #2796
- ; BLDEVN, BLDPD1, BLDPID^VAFCQRY - #3630
- ; ^DPT("AICN" - #2070
- ; DELETETF^VAFCTFU, FILE^VAFCTFU - #2988
- ;
- ;PROCESS A24 RESULTING FROM A28 ADD TO MPI MESSAGE OR FROM A40 MERGE
- A24 ;
- N MPII,MPIJ,ARRY,SEG,CNT,ERR,SITE,MSG,DFN,IEN,LIST,RARRY
- S (CNT,ERR,FIRST)=1
- F MPII=1:1 X HLNEXT Q:HLQUIT'>0 S MSG=HLNODE D
- .S MPIJ=0 F S MPIJ=$O(HLNODE(MPIJ)) Q:'MPIJ S MSG(MPIJ)=HLNODE(MPIJ)
- .S SEG=$E(HLNODE,1,3)
- .I SEG="MSH" D MSH(.ARRY,.MSG) Q
- .I SEG="EVN" D EVN(.ARRY,.MSG) Q
- .I SEG="PID" D PID(.ARRY,.MSG,FIRST) D:FIRST=1 S FIRST=2 Q
- ..;preserve the retained ICN values 991.01 and 991.02
- .. S RARRY(991.01)=ARRY(991.01),RARRY(991.02)=ARRY(991.02)
- .I SEG="PD1" D PD1(.ARRY,.MSG) Q
- ;
- ;restore the retained ICN values
- S ARRY(991.01)=RARRY(991.01),ARRY(991.02)=RARRY(991.02)
- ;UPDATE 991.01, 991.02, 991.03
- ;**41 first check for DFN, if this DFN location is here
- I $G(ARRY("DFN",2))'=""&($G(ARRY("DFNLOC"))=$P($$SITE^VASITE,"^",3)) S DFN=ARRY("DFN",2)
- ;**41 if dfn is not passed set DFN from ICN
- I $G(DFN)="" D
- . I $G(ARRY("ICN",2))'="" S DFN=$$GETDFN^MPIF001(ARRY("ICN",2))
- . I $G(ARRY("ICN",2))=""!(+$G(DFN)'>0) D
- .. I $G(ARRY("DFN",2))'="" S DFN=ARRY("DFN",2)
- .. I $G(ARRY("DFN",2))="" S DFN=ARRY("DFN",1)
- S ARRY(991.03)=$S(ARRY(991.03)="":"@",1:$$LKUP^XUAF4(ARRY(991.03))) ;**59 - MVI_2688 (dri)
- I +$G(DFN)'>0 S ERR="-1^Unknown Identifier(s) ICN#"_$G(ARRY("ICN",2))_" and DFN#"_$G(ARRY("DFN",2))
- I +$G(DFN)>0 S ERR=$$UPDATE^MPIFAPI(DFN,"ARRY",0) D
- .;remove ALL Treating Facilities except your sites and add the CMOR
- .D TFL^VAFCTFU1(.LIST,DFN) I $O(LIST(0)) D
- .. N LOC,MPINODE,LOCIEN,CMOR,MPIFX,ERROR
- .. S (CMOR,MPIFX)=0 F S MPIFX=$O(LIST(MPIFX)) Q:'MPIFX I $P(LIST(MPIFX),"^",5)="VAMC" D
- ... ;get MPI node
- ... S MPINODE=$$MPINODE^MPIFAPI(DFN),LOC=$P(LIST(MPIFX),"^"),LOCIEN=$$IEN^XUAF4(LOC)
- ... I LOC=$P($$SITE^VASITE,"^",3) Q ;do not delete own site
- ... I LOCIEN=$P(MPINODE,"^",3) S CMOR=LOCIEN Q ;do not delete CMOR site
- ... S ERROR=$$DELETETF^VAFCTFU($P(MPINODE,"^",1),LOCIEN)
- .. ;add CMOR site to TF list if it did not already exist
- .. I CMOR'=0 D FILE^VAFCTFU(DFN,CMOR,1)
- .; trigger A31 to MPI incase there have been edits since the ICN was created -- tasked off
- .; **39 DON'T TASK OFF A31 IF MOVING FROM ONE NATIONAL ICN TO A DIFFERENT NATIONAL ICN
- .I ARRY("ICN",1)=ARRY("ICN",2) D
- ..S ZTRTN="TA31^MPIFA31B",ZTDESC="A31 triggered from A24 for DFN "_DFN ;**39 added DFN to text
- ..S ZTSAVE("DFN")=DFN,ZTIO="",ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,1,0)
- ..D ^%ZTLOAD
- .I ARRY("ICN",1)'=ARRY("ICN",2) D RESEX^MPIFDUP(DFN,2) ;**48
- .K ZTRTN,ZTDESC,ZTIO,ZTSAVE,ZTDTH,ZTREQ
- ;
- N AA S AA="AA"
- I $G(ERR)'>0,$P($G(ERR),"^",2)["is already in use for pt DFN" S AA="AE" ;**52 MPIC_1681/1753
- S HLA("HLA",1)="MSA"_HL("FS")_AA_HL("FS")_HL("MID")_HL("FS")_$S(+$G(ERR)'>0:$P(ERR,"^",2),1:"")
- S $P(HLA("HLA",1),HL("FS"),7)="ICN="_ARRY("ICN",1)
- ;**75 - Story - 1260465 (ckn) - Include 200M in HLL links for HAC
- D LINK^HLUTIL3(ARRY("SITE"),.LINK) S IEN=$O(LINK(0)),HLL("LINKS",1)="^"_LINK(IEN)_$S($P($$SITE^VASITE(),"^",3)=741:"^200M",1:"")
- D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.MPIFRSLT,"",.HL)
- K LINK,MPIFRSLT
- ;PATCH 25
- I ARRY("ICN",1)'=ARRY("ICN",2),ARRY("ICN",2)'="" D
- .; ^ checking if this is a result of a "merge" of ICNs from the MPI
- .; to trigger if this is station 200 the MERGE for the FHIE Framework
- .Q:$P($$SITE^VASITE,"^",3)'=200
- .N FHIE S FHIE=$$MERGE^OMGPIDMI(ARRY("ICN",2),ARRY("ICN",1))
- .; ^^ THIS API IS ONLY AVAILABLE ON THE FHIE HOST SYSTEM
- .I +FHIE=-1 D START^RGHLLOG(),EXC^RGHLLOG(208,$P(FHIE,"^",2),DFN),STOP^RGHLLOG()
- Q
- ;
- MSH(ARY,MSG) ;processing MSH fields
- N COMP
- S COMP=$E(HL("ECH"),1)
- S ARY("SITE")=$$LKUP^XUAF4($P($P(MSG,HL("FS"),4),COMP))
- Q
- ;
- EVN(ARY,MSG) ;processing EVN fields
- S ARY("EVTR")=$P(MSG,HL("FS"),2) ;not currently used
- S ARY("DLT")=$$FMDATE^HLFNC($P(MSG,HL("FS"),3))
- Q
- ;
- PID(ARY,MSG,FIRST) ;processing PID fields
- N REP,PID,COMP,SUBCOMP,MPIDFN,MPISSN,ICN
- S REP=$E(HL("ECH"),2),COMP=$E(HL("ECH"),1),SUBCOMP=$E(HL("ECH"),4)
- S MPISSN="",MPIDFN=""
- ;**41 replaced with line below D PIDPROC^MPIFA43(.ICN,.MPISSN,.MPIDFN,.PID)
- D PIDP^RGADTP1(.MSG,.ARY,.HL)
- I FIRST=1 S ARY(991.01)=+ARY("ICN"),ARY(991.02)=$P(ARY("ICN"),"V",2)
- S ARY("ICN",FIRST)=ARY("ICN")
- S ARY("SSN",FIRST)=ARY("SSN")
- S ARY("DFN",FIRST)=ARY("DFN")
- Q
- ;
- PD1(ARY,MSG) ;processing PD1 fields
- N COMP
- S COMP=$E(HL("ECH"),1)
- S ARY(991.03)=$P($P(HLNODE,HL("FS"),4),COMP,3)
- Q
- ;
- PROC ;
- 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
- ..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)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMPIFA24 5170 printed Jan 18, 2025@03:11:52 Page 2
- MPIFA24 ;BPOFO/CMC-A24 PROCESSING ROUTINE ; 5/4/20 10:58am
- +1 ;;1.0;MASTER PATIENT INDEX VISTA;**22,24,27,31,25,41,39,48,52,59,75**;30 Apr 99;Build 1
- +2 ;
- +3 ; Integration Agreements Utilized:
- +4 ; START, EXC, STOP^RGHLLOG - #2796
- +5 ; BLDEVN, BLDPD1, BLDPID^VAFCQRY - #3630
- +6 ; ^DPT("AICN" - #2070
- +7 ; DELETETF^VAFCTFU, FILE^VAFCTFU - #2988
- +8 ;
- +9 ;PROCESS A24 RESULTING FROM A28 ADD TO MPI MESSAGE OR FROM A40 MERGE
- A24 ;
- +1 NEW MPII,MPIJ,ARRY,SEG,CNT,ERR,SITE,MSG,DFN,IEN,LIST,RARRY
- +2 SET (CNT,ERR,FIRST)=1
- +3 FOR MPII=1:1
- XECUTE HLNEXT
- if HLQUIT'>0
- QUIT
- SET MSG=HLNODE
- Begin DoDot:1
- +4 SET MPIJ=0
- FOR
- SET MPIJ=$ORDER(HLNODE(MPIJ))
- if 'MPIJ
- QUIT
- SET MSG(MPIJ)=HLNODE(MPIJ)
- +5 SET SEG=$EXTRACT(HLNODE,1,3)
- +6 IF SEG="MSH"
- DO MSH(.ARRY,.MSG)
- QUIT
- +7 IF SEG="EVN"
- DO EVN(.ARRY,.MSG)
- QUIT
- +8 IF SEG="PID"
- DO PID(.ARRY,.MSG,FIRST)
- if FIRST=1
- Begin DoDot:2
- +9 ;preserve the retained ICN values 991.01 and 991.02
- +10 SET RARRY(991.01)=ARRY(991.01)
- SET RARRY(991.02)=ARRY(991.02)
- End DoDot:2
- SET FIRST=2
- QUIT
- +11 IF SEG="PD1"
- DO PD1(.ARRY,.MSG)
- QUIT
- End DoDot:1
- +12 ;
- +13 ;restore the retained ICN values
- +14 SET ARRY(991.01)=RARRY(991.01)
- SET ARRY(991.02)=RARRY(991.02)
- +15 ;UPDATE 991.01, 991.02, 991.03
- +16 ;**41 first check for DFN, if this DFN location is here
- +17 IF $GET(ARRY("DFN",2))'=""&($GET(ARRY("DFNLOC"))=$PIECE($$SITE^VASITE,"^",3))
- SET DFN=ARRY("DFN",2)
- +18 ;**41 if dfn is not passed set DFN from ICN
- +19 IF $GET(DFN)=""
- Begin DoDot:1
- +20 IF $GET(ARRY("ICN",2))'=""
- SET DFN=$$GETDFN^MPIF001(ARRY("ICN",2))
- +21 IF $GET(ARRY("ICN",2))=""!(+$GET(DFN)'>0)
- Begin DoDot:2
- +22 IF $GET(ARRY("DFN",2))'=""
- SET DFN=ARRY("DFN",2)
- +23 IF $GET(ARRY("DFN",2))=""
- SET DFN=ARRY("DFN",1)
- End DoDot:2
- End DoDot:1
- +24 ;**59 - MVI_2688 (dri)
- SET ARRY(991.03)=$SELECT(ARRY(991.03)="":"@",1:$$LKUP^XUAF4(ARRY(991.03)))
- +25 IF +$GET(DFN)'>0
- SET ERR="-1^Unknown Identifier(s) ICN#"_$GET(ARRY("ICN",2))_" and DFN#"_$GET(ARRY("DFN",2))
- +26 IF +$GET(DFN)>0
- SET ERR=$$UPDATE^MPIFAPI(DFN,"ARRY",0)
- Begin DoDot:1
- +27 ;remove ALL Treating Facilities except your sites and add the CMOR
- +28 DO TFL^VAFCTFU1(.LIST,DFN)
- IF $ORDER(LIST(0))
- Begin DoDot:2
- +29 NEW LOC,MPINODE,LOCIEN,CMOR,MPIFX,ERROR
- +30 SET (CMOR,MPIFX)=0
- FOR
- SET MPIFX=$ORDER(LIST(MPIFX))
- if 'MPIFX
- QUIT
- IF $PIECE(LIST(MPIFX),"^",5)="VAMC"
- Begin DoDot:3
- +31 ;get MPI node
- +32 SET MPINODE=$$MPINODE^MPIFAPI(DFN)
- SET LOC=$PIECE(LIST(MPIFX),"^")
- SET LOCIEN=$$IEN^XUAF4(LOC)
- +33 ;do not delete own site
- IF LOC=$PIECE($$SITE^VASITE,"^",3)
- QUIT
- +34 ;do not delete CMOR site
- IF LOCIEN=$PIECE(MPINODE,"^",3)
- SET CMOR=LOCIEN
- QUIT
- +35 SET ERROR=$$DELETETF^VAFCTFU($PIECE(MPINODE,"^",1),LOCIEN)
- End DoDot:3
- +36 ;add CMOR site to TF list if it did not already exist
- +37 IF CMOR'=0
- DO FILE^VAFCTFU(DFN,CMOR,1)
- End DoDot:2
- +38 ; trigger A31 to MPI incase there have been edits since the ICN was created -- tasked off
- +39 ; **39 DON'T TASK OFF A31 IF MOVING FROM ONE NATIONAL ICN TO A DIFFERENT NATIONAL ICN
- +40 IF ARRY("ICN",1)=ARRY("ICN",2)
- Begin DoDot:2
- +41 ;**39 added DFN to text
- SET ZTRTN="TA31^MPIFA31B"
- SET ZTDESC="A31 triggered from A24 for DFN "_DFN
- +42 SET ZTSAVE("DFN")=DFN
- SET ZTIO=""
- SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,1,0)
- +43 DO ^%ZTLOAD
- End DoDot:2
- +44 ;**48
- IF ARRY("ICN",1)'=ARRY("ICN",2)
- DO RESEX^MPIFDUP(DFN,2)
- +45 KILL ZTRTN,ZTDESC,ZTIO,ZTSAVE,ZTDTH,ZTREQ
- End DoDot:1
- +46 ;
- +47 NEW AA
- SET AA="AA"
- +48 ;**52 MPIC_1681/1753
- IF $GET(ERR)'>0
- IF $PIECE($GET(ERR),"^",2)["is already in use for pt DFN"
- SET AA="AE"
- +49 SET HLA("HLA",1)="MSA"_HL("FS")_AA_HL("FS")_HL("MID")_HL("FS")_$SELECT(+$GET(ERR)'>0:$PIECE(ERR,"^",2),1:"")
- +50 SET $PIECE(HLA("HLA",1),HL("FS"),7)="ICN="_ARRY("ICN",1)
- +51 ;**75 - Story - 1260465 (ckn) - Include 200M in HLL links for HAC
- +52 DO LINK^HLUTIL3(ARRY("SITE"),.LINK)
- SET IEN=$ORDER(LINK(0))
- SET HLL("LINKS",1)="^"_LINK(IEN)_$SELECT($PIECE($$SITE^VASITE(),"^",3)=741:"^200M",1:"")
- +53 DO GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.MPIFRSLT,"",.HL)
- +54 KILL LINK,MPIFRSLT
- +55 ;PATCH 25
- +56 IF ARRY("ICN",1)'=ARRY("ICN",2)
- IF ARRY("ICN",2)'=""
- Begin DoDot:1
- +57 ; ^ checking if this is a result of a "merge" of ICNs from the MPI
- +58 ; to trigger if this is station 200 the MERGE for the FHIE Framework
- +59 if $PIECE($$SITE^VASITE,"^",3)'=200
- QUIT
- +60 NEW FHIE
- SET FHIE=$$MERGE^OMGPIDMI(ARRY("ICN",2),ARRY("ICN",1))
- +61 ; ^^ THIS API IS ONLY AVAILABLE ON THE FHIE HOST SYSTEM
- +62 IF +FHIE=-1
- DO START^RGHLLOG()
- DO EXC^RGHLLOG(208,$PIECE(FHIE,"^",2),DFN)
- DO STOP^RGHLLOG()
- End DoDot:1
- +63 QUIT
- +64 ;
- MSH(ARY,MSG) ;processing MSH fields
- +1 NEW COMP
- +2 SET COMP=$EXTRACT(HL("ECH"),1)
- +3 SET ARY("SITE")=$$LKUP^XUAF4($PIECE($PIECE(MSG,HL("FS"),4),COMP))
- +4 QUIT
- +5 ;
- EVN(ARY,MSG) ;processing EVN fields
- +1 ;not currently used
- SET ARY("EVTR")=$PIECE(MSG,HL("FS"),2)
- +2 SET ARY("DLT")=$$FMDATE^HLFNC($PIECE(MSG,HL("FS"),3))
- +3 QUIT
- +4 ;
- PID(ARY,MSG,FIRST) ;processing PID fields
- +1 NEW REP,PID,COMP,SUBCOMP,MPIDFN,MPISSN,ICN
- +2 SET REP=$EXTRACT(HL("ECH"),2)
- SET COMP=$EXTRACT(HL("ECH"),1)
- SET SUBCOMP=$EXTRACT(HL("ECH"),4)
- +3 SET MPISSN=""
- SET MPIDFN=""
- +4 ;**41 replaced with line below D PIDPROC^MPIFA43(.ICN,.MPISSN,.MPIDFN,.PID)
- +5 DO PIDP^RGADTP1(.MSG,.ARY,.HL)
- +6 IF FIRST=1
- SET ARY(991.01)=+ARY("ICN")
- SET ARY(991.02)=$PIECE(ARY("ICN"),"V",2)
- +7 SET ARY("ICN",FIRST)=ARY("ICN")
- +8 SET ARY("SSN",FIRST)=ARY("SSN")
- +9 SET ARY("DFN",FIRST)=ARY("DFN")
- +10 QUIT
- +11 ;
- PD1(ARY,MSG) ;processing PD1 fields
- +1 NEW COMP
- +2 SET COMP=$EXTRACT(HL("ECH"),1)
- +3 SET ARY(991.03)=$PIECE($PIECE(HLNODE,HL("FS"),4),COMP,3)
- +4 QUIT
- +5 ;
- PROC ;
- +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
- +6 DO START^RGHLLOG(HLMTIEN,"","")
- +7 DO EXC^RGHLLOG(208,$PIECE(HLNODE,HL("FS"),4)_" for HL msg# "_HLMTIEN,DFN)
- +8 DO STOP^RGHLLOG(0)
- End DoDot:2
- End DoDot:1
- +9 KILL ^XTMP("MPIFA24%"_DFN)
- +10 QUIT