VAFCTFPR ;ALB/JLU,CML-MFU PROCESSING ROUTINE ;06/25/98
;;5.3;Registration;**149,261,255,307,414,474,520,712**;Aug 13, 1993;Build 7
;Reference to EXC^RGHLLOG and START^RGHLLOG supported by IA #2796
;
EN ;This entry point is used to process the Master File Update Message.
;It is called by the VAFC MFU-TFL ClIENT when a MFU message is received
;There are no inputs or outputs
;
;quit if Master Patient Index (MPI) is not installed
S X="MPIF001" X ^%ZOSF("TEST") Q:'$T
S X="MPIFQ0" X ^%ZOSF("TEST") Q:'$T
S X="RGRSBUL1" X ^%ZOSF("TEST") Q:'$T
S X="RGRSBULL" X ^%ZOSF("TEST") Q:'$T
K X N ICN,PDFN,TYPE,VAFCER,VAFCARR,SG
N VAFC,MFNQUIT,VAFCI,MSG,MFUPT,INST,PDLT,VAFCTFT
MFN ;Read Treating Facility MFN M05 (PROCESS LOGIC) msg into VAFC()
F VAFCI=1:1 X HLNEXT Q:HLQUIT'>0 S VAFC(VAFCI)=HLNODE
MFNP ;Process in the TF updates messages
S VAFCI="" F S VAFCI=$O(VAFC(VAFCI)) Q:'VAFCI!($G(MFNQUIT)=1) S MSG=VAFC(VAFCI),SG=$E(MSG,1,3) D:SG?2A1(1A,1N) PICK
Q
INIT ;Process in the ADT A04/A08 (routing logic)
F VAFCI=1:1 X HLNEXT Q:HLQUIT'>0 S (MSG,VAFC(VAFCI))=HLNODE,SG=$E(HLNODE,1,3) D:SG?2A1(1A,1N) PICK
Q
PICK ;check routine for segment entry point
I $T(@SG)]"" D @SG
I $T(@SG)="" Q
Q
MSH ;;MSH
;process the MSH segment
D START^RGHLLOG($G(HLMTIENS))
S (HLFS,HL("FS"))=$E(MSG,4),(HLECH,HL("ECH"))=$E(MSG,5,8)
S VAFCARR("SENDING SITE")=$P(MSG,HL("FS"),4)
Q
EVN ;;EVN
;process the EVN segment
S STATN=+$$SITE^VASITE()_"^"_$$FMDATE^HLFNC($P(MSG,HL("FS"),3))
Q
PID ;;PID
;process the PID segment
S PDFN=+$P(MSG,HL("FS"),4)
Q
MFI ;;MFI
;process the MFI segment
N NXTSGMT,VAFCMPI
S MFUPT=$P(MSG,HL("FS"),2)
;master file update type is not TFL SET quit flag
I MFUPT'="TFL" S MFNQUIT=1 Q
N HLCOMP
S HLCOMP=$E(HL("ECH"),1)
S TYPE=$P(MSG,HL("FS"),4)
;is this coming from the CMOR if so pass a '1' to FILE to end transmission
S VAFCTFT=0 I TYPE="REP" S VAFCTFT=1
S VAFCARR("CMOR")=$P($P(MSG,HL("FS"),8),HLCOMP,1)
S NXTSGMT=$G(VAFC(+$O(VAFC(VAFCI))))
I $P(NXTSGMT,HL("FS"))="MFE" S ICN=$P($P(NXTSGMT,HL("FS"),5),HLCOMP,4) I $G(ICN)="" S MFNQUIT=1 D EXC^RGHLLOG(210,"Msg#"_$G(HL("MID"))_" failed to Update TF from "_$G(VAFCARR("SENDING SITE"))_". ICN not sent.",$G(PDFN)) Q
;check for CMOR mismatch
S PDFN=$$GETDFN^MPIF001(ICN)
I +$G(PDFN)<0 S MFNQUIT=1 D EXC^RGHLLOG(210,"Msg#"_$G(HL("MID"))_" failed to update TF from "_$G(VAFCARR("SENDING SITE"))_" for ICN#"_$G(ICN)) Q
S VAFCMPI=$$MPINODE^MPIFAPI(PDFN)
;if from CMOR delete all TF's and replace with CMOR's list (need to log exception if problems deleting TF's)
I TYPE="REP" D
. ;if CMOR mismatch quit the exception will be logged in MFE subroutine
.;**712 NO NEED TO CHECK CMOR ANYMORE I $P($G(VAFCMPI),"^",3)'=$G(VAFCARR("CMOR")) Q
. S VAFCER=$$DELALLTF^VAFCTFU(ICN) I VAFCER S MFNQUIT=1 D EXC^RGHLLOG(212,"Msg#"_$G(HL("MID"))_" failed to Delete ALL TF's for ICN#"_$G(ICN),$G(PDFN)) Q
Q
MFE ;;MFE
;process the MFE segment
N HLCOMP,NXTSGMT
S HLCOMP=$E(HL("ECH"),1)
S PDLT=$$FMDATE^HLFNC($P(MSG,HL("FS"),4))
S INST=$P($P(MSG,HL("FS"),5),HLCOMP) ; **520 REMOVE + AND GET PIECE
S INST=$$LKUP^XUAF4(INST) ; **520 REMOVE +
I INST="" S MFNQUIT=1 Q ; log exception, set MFNQUIT flag and quit
S PDFN=$$GETDFN^MPIF001(ICN)
D Q:$G(MFNQUIT)=1
.;if unable to get DFN from ICN set MFNQUIT flag and quit
.I +$G(PDFN)<0 S MFNQUIT=1 D EXC^RGHLLOG(210,"Msg#"_$G(HL("MID"))_" failed to update TF from "_$G(VAFCARR("SENDING SITE"))_" for ICN#"_$G(ICN)) Q
.N VAFCDATA,LOCNAME,LASTNAME,LOCSSN,LOCICN,LOCCMOR
.S LOCNAME=$$GET1^DIQ(2,+PDFN_",",.01)
.S LASTNAME=$P(LOCNAME,",",1)
.S LOCSSN=$$GET1^DIQ(2,+PDFN_",",.09)
.S LOCICN=+$$GETICN^MPIF001(PDFN)
.S LOCCMOR=$$GETVCCI^MPIF001(PDFN)
.;CMOR MISMATCH or CMOR = null log exception, set MFNQUIT flag and quit
.;**712 NO NEED TO CHECK CMOR ANYMORE
.;I LOCCMOR'=VAFCARR("CMOR")!(VAFCARR("CMOR")="") D Q
.;.D EXC^RGHLLOG(211,"Msg#"_$G(HL("MID"))_" failed to update from "_$G(VAFCARR("SENDING SITE"))_" for "_$G(LOCNAME)_" ICN#"_$G(ICN)_" due to mismatch CMOR "_$G(VAFCARR("CMOR"))_"/"_$G(LOCCMOR)_" (local)",$G(PDFN)) S MFNQUIT=1
;check next segment, if it exist and it is a ZET segment quit and let the ZET module add the TF
S NXTSGMT=$G(VAFC(+$O(VAFC(VAFCI)))) I $P($G(NXTSGMT),HL("FS"))="ZET" Q
D FILE^VAFCTFU(PDFN,INST_"^"_$G(PDLT),$G(VAFCTFT))
Q
ZET ;;ZET
;process Patient's Date Last Treated Event Type, ZET segment
K PDLTET
S PDLTET=$P(MSG,HL("FS"),2)
D FILE^VAFCTFU(PDFN,INST_"^"_PDLT_"^"_PDLTET,$G(VAFCTFT))
Q
TFPRQ Q
;
POPQ Q
;
UP ;entry point to process local A04 messages.
;This is call by the VAFC TFL-UPDATE CLIENT
N STATN,PDFN,VAFCARR,HLFS,HLECH,SG,VAFCI
N VAFC
D INIT
;file the TF and trigger the TF update
D FILE^VAFCTFU(PDFN,+$$SITE^VASITE,1)
UPQ Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFCTFPR 4833 printed Apr 09, 2024@21:45:27 Page 2
VAFCTFPR ;ALB/JLU,CML-MFU PROCESSING ROUTINE ;06/25/98
+1 ;;5.3;Registration;**149,261,255,307,414,474,520,712**;Aug 13, 1993;Build 7
+2 ;Reference to EXC^RGHLLOG and START^RGHLLOG supported by IA #2796
+3 ;
EN ;This entry point is used to process the Master File Update Message.
+1 ;It is called by the VAFC MFU-TFL ClIENT when a MFU message is received
+2 ;There are no inputs or outputs
+3 ;
+4 ;quit if Master Patient Index (MPI) is not installed
+5 SET X="MPIF001"
XECUTE ^%ZOSF("TEST")
if '$TEST
QUIT
+6 SET X="MPIFQ0"
XECUTE ^%ZOSF("TEST")
if '$TEST
QUIT
+7 SET X="RGRSBUL1"
XECUTE ^%ZOSF("TEST")
if '$TEST
QUIT
+8 SET X="RGRSBULL"
XECUTE ^%ZOSF("TEST")
if '$TEST
QUIT
+9 KILL X
NEW ICN,PDFN,TYPE,VAFCER,VAFCARR,SG
+10 NEW VAFC,MFNQUIT,VAFCI,MSG,MFUPT,INST,PDLT,VAFCTFT
MFN ;Read Treating Facility MFN M05 (PROCESS LOGIC) msg into VAFC()
+1 FOR VAFCI=1:1
XECUTE HLNEXT
if HLQUIT'>0
QUIT
SET VAFC(VAFCI)=HLNODE
MFNP ;Process in the TF updates messages
+1 SET VAFCI=""
FOR
SET VAFCI=$ORDER(VAFC(VAFCI))
if 'VAFCI!($GET(MFNQUIT)=1)
QUIT
SET MSG=VAFC(VAFCI)
SET SG=$EXTRACT(MSG,1,3)
if SG?2A1(1A,1N)
DO PICK
+2 QUIT
INIT ;Process in the ADT A04/A08 (routing logic)
+1 FOR VAFCI=1:1
XECUTE HLNEXT
if HLQUIT'>0
QUIT
SET (MSG,VAFC(VAFCI))=HLNODE
SET SG=$EXTRACT(HLNODE,1,3)
if SG?2A1(1A,1N)
DO PICK
+2 QUIT
PICK ;check routine for segment entry point
+1 IF $TEXT(@SG)]""
DO @SG
+2 IF $TEXT(@SG)=""
QUIT
+3 QUIT
MSH ;;MSH
+1 ;process the MSH segment
+2 DO START^RGHLLOG($GET(HLMTIENS))
+3 SET (HLFS,HL("FS"))=$EXTRACT(MSG,4)
SET (HLECH,HL("ECH"))=$EXTRACT(MSG,5,8)
+4 SET VAFCARR("SENDING SITE")=$PIECE(MSG,HL("FS"),4)
+5 QUIT
EVN ;;EVN
+1 ;process the EVN segment
+2 SET STATN=+$$SITE^VASITE()_"^"_$$FMDATE^HLFNC($PIECE(MSG,HL("FS"),3))
+3 QUIT
PID ;;PID
+1 ;process the PID segment
+2 SET PDFN=+$PIECE(MSG,HL("FS"),4)
+3 QUIT
MFI ;;MFI
+1 ;process the MFI segment
+2 NEW NXTSGMT,VAFCMPI
+3 SET MFUPT=$PIECE(MSG,HL("FS"),2)
+4 ;master file update type is not TFL SET quit flag
+5 IF MFUPT'="TFL"
SET MFNQUIT=1
QUIT
+6 NEW HLCOMP
+7 SET HLCOMP=$EXTRACT(HL("ECH"),1)
+8 SET TYPE=$PIECE(MSG,HL("FS"),4)
+9 ;is this coming from the CMOR if so pass a '1' to FILE to end transmission
+10 SET VAFCTFT=0
IF TYPE="REP"
SET VAFCTFT=1
+11 SET VAFCARR("CMOR")=$PIECE($PIECE(MSG,HL("FS"),8),HLCOMP,1)
+12 SET NXTSGMT=$GET(VAFC(+$ORDER(VAFC(VAFCI))))
+13 IF $PIECE(NXTSGMT,HL("FS"))="MFE"
SET ICN=$PIECE($PIECE(NXTSGMT,HL("FS"),5),HLCOMP,4)
IF $GET(ICN)=""
SET MFNQUIT=1
DO EXC^RGHLLOG(210,"Msg#"_$GET(HL("MID"))_" failed to Update TF from "_$GET(VAFCARR("SENDING SITE"))_". ICN not sent.",$GET(PDFN))
QUIT
+14 ;check for CMOR mismatch
+15 SET PDFN=$$GETDFN^MPIF001(ICN)
+16 IF +$GET(PDFN)<0
SET MFNQUIT=1
DO EXC^RGHLLOG(210,"Msg#"_$GET(HL("MID"))_" failed to update TF from "_$GET(VAFCARR("SENDING SITE"))_" for ICN#"_$GET(ICN))
QUIT
+17 SET VAFCMPI=$$MPINODE^MPIFAPI(PDFN)
+18 ;if from CMOR delete all TF's and replace with CMOR's list (need to log exception if problems deleting TF's)
+19 IF TYPE="REP"
Begin DoDot:1
+20 ;if CMOR mismatch quit the exception will be logged in MFE subroutine
+21 ;**712 NO NEED TO CHECK CMOR ANYMORE I $P($G(VAFCMPI),"^",3)'=$G(VAFCARR("CMOR")) Q
+22 SET VAFCER=$$DELALLTF^VAFCTFU(ICN)
IF VAFCER
SET MFNQUIT=1
DO EXC^RGHLLOG(212,"Msg#"_$GET(HL("MID"))_" failed to Delete ALL TF's for ICN#"_$GET(ICN),$GET(PDFN))
QUIT
End DoDot:1
+23 QUIT
MFE ;;MFE
+1 ;process the MFE segment
+2 NEW HLCOMP,NXTSGMT
+3 SET HLCOMP=$EXTRACT(HL("ECH"),1)
+4 SET PDLT=$$FMDATE^HLFNC($PIECE(MSG,HL("FS"),4))
+5 ; **520 REMOVE + AND GET PIECE
SET INST=$PIECE($PIECE(MSG,HL("FS"),5),HLCOMP)
+6 ; **520 REMOVE +
SET INST=$$LKUP^XUAF4(INST)
+7 ; log exception, set MFNQUIT flag and quit
IF INST=""
SET MFNQUIT=1
QUIT
+8 SET PDFN=$$GETDFN^MPIF001(ICN)
+9 Begin DoDot:1
+10 ;if unable to get DFN from ICN set MFNQUIT flag and quit
+11 IF +$GET(PDFN)<0
SET MFNQUIT=1
DO EXC^RGHLLOG(210,"Msg#"_$GET(HL("MID"))_" failed to update TF from "_$GET(VAFCARR("SENDING SITE"))_" for ICN#"_$GET(ICN))
QUIT
+12 NEW VAFCDATA,LOCNAME,LASTNAME,LOCSSN,LOCICN,LOCCMOR
+13 SET LOCNAME=$$GET1^DIQ(2,+PDFN_",",.01)
+14 SET LASTNAME=$PIECE(LOCNAME,",",1)
+15 SET LOCSSN=$$GET1^DIQ(2,+PDFN_",",.09)
+16 SET LOCICN=+$$GETICN^MPIF001(PDFN)
+17 SET LOCCMOR=$$GETVCCI^MPIF001(PDFN)
+18 ;CMOR MISMATCH or CMOR = null log exception, set MFNQUIT flag and quit
+19 ;**712 NO NEED TO CHECK CMOR ANYMORE
+20 ;I LOCCMOR'=VAFCARR("CMOR")!(VAFCARR("CMOR")="") D Q
+21 ;.D EXC^RGHLLOG(211,"Msg#"_$G(HL("MID"))_" failed to update from "_$G(VAFCARR("SENDING SITE"))_" for "_$G(LOCNAME)_" ICN#"_$G(ICN)_" due to mismatch CMOR "_$G(VAFCARR("CMOR"))_"/"_$G(LOCCMOR)_" (local)",$G(PDFN)) S MFNQUIT=1
End DoDot:1
if $GET(MFNQUIT)=1
QUIT
+22 ;check next segment, if it exist and it is a ZET segment quit and let the ZET module add the TF
+23 SET NXTSGMT=$GET(VAFC(+$ORDER(VAFC(VAFCI))))
IF $PIECE($GET(NXTSGMT),HL("FS"))="ZET"
QUIT
+24 DO FILE^VAFCTFU(PDFN,INST_"^"_$GET(PDLT),$GET(VAFCTFT))
+25 QUIT
ZET ;;ZET
+1 ;process Patient's Date Last Treated Event Type, ZET segment
+2 KILL PDLTET
+3 SET PDLTET=$PIECE(MSG,HL("FS"),2)
+4 DO FILE^VAFCTFU(PDFN,INST_"^"_PDLT_"^"_PDLTET,$GET(VAFCTFT))
+5 QUIT
TFPRQ QUIT
+1 ;
POPQ QUIT
+1 ;
UP ;entry point to process local A04 messages.
+1 ;This is call by the VAFC TFL-UPDATE CLIENT
+2 NEW STATN,PDFN,VAFCARR,HLFS,HLECH,SG,VAFCI
+3 NEW VAFC
+4 DO INIT
+5 ;file the TF and trigger the TF update
+6 DO FILE^VAFCTFU(PDFN,+$$SITE^VASITE,1)
UPQ QUIT
