VAFCTFIN ;BIR/DR-TREATING FACILTIY MFU PROCESSING ROUTINE ; 1/21/10 4:26pm
;;5.3;PIMS;**428,474,520,639,707,1015,1016**;JUN 30, 2012;Build 20
;Reference to EXC, START, and STOP^RGHLLOG supported by IA #2796
;
IN ;This entry point is used to process the Treating Facility Master File Update Message.
;It is called by the VAFC MFN-M05 CLIENT processing routine when a MFN
;message is received.
;There are no inputs or outputs
;
;Initial check whether incoming MFN message is old format or new. If it is old format, go to old routine (VAFCOFIN) to process. **821
I HL("MTN")="MFK" D RSP Q
N VAFC,SG,MSG
F VAFCI=1:1 X HLNEXT Q:HLQUIT'>0 I $E(HLNODE,1,3)="MFE" S MSG=HLNODE
I $P($G(MSG),"^",3)'["-" D IN^VAFCOFIN Q
K VAFCI,HLNODE,SG,HLQUIT,HLDONE,MSG
S HLQUIT=0
;
N VAFC,STATN,VAFCI,MSG,SG,VAFCARR,PDFN,INST,MFUPT,PDLT,TFIEN
N ICN,MFI,MFE,MFA,HLCOMP,CNT,X,VAFCERR,VAFCX
;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
INIT ;Process in the Treating Facility MFN msg
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
;reconcil the inbound TF list from the MPI to the local TF list
D RECONCIL
;create response message
S CNT=1
S HLA("HLA",1)="MSA"_HL("FS")_"AA"_HL("FS")_HL("MID")_HL("FS") S CNT=CNT+1
S HLA("HLA",CNT)=MFI S CNT=CNT+1
;S VAFCX=0 F S VAFCX=$O(MFE(VAFCX)) Q:'VAFCX S HLA("HLA",CNT)=MFE(VAFCX),CNT=CNT+1,HLA("HLA",CNT)=MFA(VAFCX),CNT=CNT+1
S VAFCX=0 F S VAFCX=$O(MFE(VAFCX)) Q:'VAFCX D
. S VAFCN=0 F S VAFCN=$O(MFE(VAFCX,VAFCN)) Q:'VAFCN D
.. S HLA("HLA",CNT)=MFE(VAFCX,VAFCN),CNT=CNT+1,HLA("HLA",CNT)=MFA(VAFCX,VAFCN),CNT=CNT+1
;generate an application level ack (MFK) identifying the status of the adds/edits/deletes of TF's passed in
D ROUTE
D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.VAFCERR,"",.HLP)
Q
PICK ;check routine for segment entry point
I $T(@SG)]"" D @SG
I $T(@SG)="" Q
Q
MSH ;;MSH
;process the MSH segment
S (HLFS,HL("FS"))=$E(MSG,4),(HLECH,HL("ECH"))=$E(MSG,5,8)
S HLCOMP=$E(HL("ECH"),1)
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
S MFI=MSG
S MFUPT=$P(MSG,HL("FS"),4)
S VAFCARR("CMOR")=$P($P(MSG,HL("FS"),8),$E(HL("ECH"),1))
Q
MFE ;;MFE
;process the MFE segment
N HLCOMP,NXTSGMT,TYPE,REP,MFE4,DFNATST,IDENSTAT
S HLCOMP=$E(HL("ECH"),1),REP=$E(HL("ECH"),2)
S PDLT=$$FMDATE^HLFNC($P(MSG,HL("FS"),4))
;S ICN=$P($P(MSG,HL("FS"),5),HLCOMP,4)
;S INST=$P($P(MSG,HL("FS"),5),HLCOMP)
S TYPE=$P(MSG,HL("FS"),2)
S MFE4=$P(MSG,HL("FS"),5) ;SEQ 4
S ICN=$P($P(MFE4,REP),HLCOMP)
S INST=$P($P(MSG,HL("FS"),3),"-")
S ZCNT=$P($P(MSG,HL("FS"),3),"-",2)
S DFNATST=$P($P(MFE4,REP,2),HLCOMP)
S IDENSTAT=$S(TYPE="MDC":"H",1:"A")
S MFE(INST,ZCNT)=MSG
S MFI(ICN,INST,ZCNT)=PDLT_"^^"_TYPE_"^^^^"_DFNATST_"^"_IDENSTAT
Q
ZET ;;ZET
;process Patient's Date Last Treated Event Type, ZET segment
N PDLTET,IPP
S PDLTET=$P(MSG,HL("FS"),2)
S $P(MFI(ICN,INST,ZCNT),"^",2)=PDLTET
;DG*5.3*800 - Process In-Person Proofed
S IPP=$P(MSG,HL("FS"),3) ;In-Person Proofed
S $P(MFI(ICN,INST,ZCNT),"^",6)=IPP
Q
RSP ;response process logic entry point
Q
ROUTE ;routing logic entry point
N MPI
S MPI=$$MPILINK^MPIFAPI() D
.I $P($G(MPI),U)'=-1 S HLL("LINKS",1)="VAFC MFN-M05 CLIENT"_"^"_MPI
.I $P($G(MPI),U)=-1 D
.. N RGLOG D START^RGHLLOG(HLMTIEN,"","")
.. D EXC^RGHLLOG(224,"No MPI link identified in CIRN SITE PARAMETER file (#991.8)",$G(PDFN))
.. D STOP^RGHLLOG(0)
Q
TEST ;
W $$REPROC^HLUTIL(39266,"D IN^VAFCTFIN")
Q
RECONCIL ;
N DFN,MFIC,VAFCX,VAFCY,TFL,CNFLT,LOCCMOR,VAFCTYPE,VAFCN,IDSTAT,SID
S CNFLT=0
S DFN=$$GETDFN^MPIF001(ICN)
I DFN'>0 S CNFLT=1_"^"_$P($G(DFN),"^",2)
I MFUPT="REP" I +CNFLT=0 D TFL^VAFCTFU1(.TFL,DFN) S VAFCX=0 F S VAFCX=$O(TFL(VAFCX)) Q:'VAFCX D
. S MFIC($P(TFL(VAFCX),"^"))=TFL(VAFCX) I '$D(MFI(ICN,$P(TFL(VAFCX),"^"))) D DEL(ICN,$P(TFL(VAFCX),"^"))
;VAFCX=ICN and VAFCY=INSTITUTION
S VAFCX=0 F S VAFCX=$O(MFI(VAFCX)) Q:'VAFCX D
. S VAFCY=0 F S VAFCY=$O(MFI(VAFCX,VAFCY)) Q:'VAFCY D
.. S VAFCN=0 F S VAFCN=$O(MFI(VAFCX,VAFCY,VAFCN)) Q:'VAFCN D
... S VAFCTYPE=$P(MFI(VAFCX,VAFCY,VAFCN),"^",3)
... S SID=$P(MFI(VAFCX,VAFCY,VAFCN),"^",7)
... S IDSTAT=$P(MFI(VAFCX,VAFCY,VAFCN),"^",8)
... I +CNFLT=1 D
....S MFA(VAFCY,VAFCN)="MFA"_HL("FS")_VAFCTYPE_HL("FS")_VAFCY_"-"_VAFCN_HL("FS")_$$HLDATE^HLFNC($$NOW^XLFDT)_HL("FS")_"U"_HLCOMP_$S(VAFCTYPE="MDL":"Delete of ",1:"Update of ")
....S MFA(VAFCY,VAFCN)=$G(MFA(VAFCY,VAFCN))_VAFCY_" Failed at "_$P($$SITE^VASITE,"^",3)_" due to "_$P(CNFLT,"^",2)
... I +CNFLT=0 I VAFCTYPE="MAD"!(VAFCTYPE="MUP")!(VAFCTYPE="MDC") D ADDUPD(DFN,VAFCY,$P(MFI(VAFCX,VAFCY,VAFCN),"^"),$P(MFI(VAFCX,VAFCY,VAFCN),"^",2),$P(MFI(VAFCX,VAFCY,VAFCN),"^",6),$G(SID),$G(IDSTAT),VAFCN,VAFCTYPE)
... I +CNFLT=0 I VAFCTYPE="MDL" D DEL(ICN,VAFCY,VAFCN)
Q
ADDUPD(DFN,INST,PDLT,PDLRTET,IPP,DFNATST,IDENSTAT,ZCNT,VAFCTYPE) ;add or update TF entry
N ERROR,STA
S STA=INST
S INST=$$LKUP^XUAF4(INST)
I INST=0 S ERROR(STA)="Update of "_STA_" Failed at "_$P($$SITE^VASITE,"^",3)_" due to unknown Institution IEN "_INST_" passed into TF update."
I '$D(ERROR(STA)) D FILE^VAFCTFU(DFN,INST_"^"_$G(PDLT)_"^"_$G(PDLRTET),1,1,.ERROR,$G(IPP),DFNATST,IDENSTAT)
S MFA(STA,ZCNT)="MFA"_HL("FS")_VAFCTYPE_HL("FS")_STA_"-"_ZCNT_HL("FS")_$$HLDATE^HLFNC($$NOW^XLFDT)_HL("FS")
I '$D(ERROR(STA)) S MFA(STA,ZCNT)=MFA(STA,ZCNT)_"S"
I $D(ERROR(STA)) S MFA(STA,ZCNT)=MFA(STA,ZCNT)_"U"_HLCOMP_ERROR(STA)_HL("FS")
Q
DEL(ICN,INST) ;delete a TF entry
N ERROR,STA
S STA=INST
S INST=$$LKUP^XUAF4(INST)
S ERROR=$$DELETETF^VAFCTFU(ICN,INST)
;**821 - No need to send MFA for entries that are deleted locally
;S MFA(STA,ZCNT)="MFA"_HL("FS")_"MDL"_HL("FS")_STA_"-"_ZCNT_HL("FS")_$$HLDATE^HLFNC($$NOW^XLFDT)_HL("FS")
;I +ERROR'=1 S MFA(STA,ZCNT)=MFA(STA,ZCNT)_"S"
;I +ERROR=1 S MFA(STA,ZCNT)=MFA(STA,ZCNT)_"U"_HLCOMP_"Delete Failed: "_$P(ERROR,"^",2)
Q
VAFCTFIN ;BIR/DR-TREATING FACILTIY MFU PROCESSING ROUTINE ; 1/21/10 4:26pm
+1 ;;5.3;PIMS;**428,474,520,639,707,1015,1016**;JUN 30, 2012;Build 20
+2 ;Reference to EXC, START, and STOP^RGHLLOG supported by IA #2796
+3 ;
IN ;This entry point is used to process the Treating Facility Master File Update Message.
+1 ;It is called by the VAFC MFN-M05 CLIENT processing routine when a MFN
+2 ;message is received.
+3 ;There are no inputs or outputs
+4 ;
+5 ;Initial check whether incoming MFN message is old format or new. If it is old format, go to old routine (VAFCOFIN) to process. **821
+6 IF HL("MTN")="MFK"
DO RSP
QUIT
+7 NEW VAFC,SG,MSG
+8 FOR VAFCI=1:1
XECUTE HLNEXT
IF HLQUIT'>0
QUIT
IF $EXTRACT(HLNODE,1,3)="MFE"
SET MSG=HLNODE
+9 IF $PIECE($GET(MSG),"^",3)'["-"
DO IN^VAFCOFIN
QUIT
+10 KILL VAFCI,HLNODE,SG,HLQUIT,HLDONE,MSG
+11 SET HLQUIT=0
+12 ;
+13 NEW VAFC,STATN,VAFCI,MSG,SG,VAFCARR,PDFN,INST,MFUPT,PDLT,TFIEN
+14 NEW ICN,MFI,MFE,MFA,HLCOMP,CNT,X,VAFCERR,VAFCX
+15 ;quit if Master Patient Index (MPI) is not installed
+16 SET X="MPIF001"
XECUTE ^%ZOSF("TEST")
IF '$TEST
QUIT
+17 SET X="MPIFQ0"
XECUTE ^%ZOSF("TEST")
IF '$TEST
QUIT
+18 SET X="RGRSBUL1"
XECUTE ^%ZOSF("TEST")
IF '$TEST
QUIT
+19 SET X="RGRSBULL"
XECUTE ^%ZOSF("TEST")
IF '$TEST
QUIT
INIT ;Process in the Treating Facility MFN msg
+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 ;reconcil the inbound TF list from the MPI to the local TF list
+3 DO RECONCIL
+4 ;create response message
+5 SET CNT=1
+6 SET HLA("HLA",1)="MSA"_HL("FS")_"AA"_HL("FS")_HL("MID")_HL("FS")
SET CNT=CNT+1
+7 SET HLA("HLA",CNT)=MFI
SET CNT=CNT+1
+8 ;S VAFCX=0 F S VAFCX=$O(MFE(VAFCX)) Q:'VAFCX S HLA("HLA",CNT)=MFE(VAFCX),CNT=CNT+1,HLA("HLA",CNT)=MFA(VAFCX),CNT=CNT+1
+9 SET VAFCX=0
FOR
SET VAFCX=$ORDER(MFE(VAFCX))
IF 'VAFCX
QUIT
Begin DoDot:1
+10 SET VAFCN=0
FOR
SET VAFCN=$ORDER(MFE(VAFCX,VAFCN))
IF 'VAFCN
QUIT
Begin DoDot:2
+11 SET HLA("HLA",CNT)=MFE(VAFCX,VAFCN)
SET CNT=CNT+1
SET HLA("HLA",CNT)=MFA(VAFCX,VAFCN)
SET CNT=CNT+1
End DoDot:2
End DoDot:1
+12 ;generate an application level ack (MFK) identifying the status of the adds/edits/deletes of TF's passed in
+13 DO ROUTE
+14 DO GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.VAFCERR,"",.HLP)
+15 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 SET (HLFS,HL("FS"))=$EXTRACT(MSG,4)
SET (HLECH,HL("ECH"))=$EXTRACT(MSG,5,8)
+3 SET HLCOMP=$EXTRACT(HL("ECH"),1)
+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 SET MFI=MSG
+3 SET MFUPT=$PIECE(MSG,HL("FS"),4)
+4 SET VAFCARR("CMOR")=$PIECE($PIECE(MSG,HL("FS"),8),$EXTRACT(HL("ECH"),1))
+5 QUIT
MFE ;;MFE
+1 ;process the MFE segment
+2 NEW HLCOMP,NXTSGMT,TYPE,REP,MFE4,DFNATST,IDENSTAT
+3 SET HLCOMP=$EXTRACT(HL("ECH"),1)
SET REP=$EXTRACT(HL("ECH"),2)
+4 SET PDLT=$$FMDATE^HLFNC($PIECE(MSG,HL("FS"),4))
+5 ;S ICN=$P($P(MSG,HL("FS"),5),HLCOMP,4)
+6 ;S INST=$P($P(MSG,HL("FS"),5),HLCOMP)
+7 SET TYPE=$PIECE(MSG,HL("FS"),2)
+8 ;SEQ 4
SET MFE4=$PIECE(MSG,HL("FS"),5)
+9 SET ICN=$PIECE($PIECE(MFE4,REP),HLCOMP)
+10 SET INST=$PIECE($PIECE(MSG,HL("FS"),3),"-")
+11 SET ZCNT=$PIECE($PIECE(MSG,HL("FS"),3),"-",2)
+12 SET DFNATST=$PIECE($PIECE(MFE4,REP,2),HLCOMP)
+13 SET IDENSTAT=$SELECT(TYPE="MDC":"H",1:"A")
+14 SET MFE(INST,ZCNT)=MSG
+15 SET MFI(ICN,INST,ZCNT)=PDLT_"^^"_TYPE_"^^^^"_DFNATST_"^"_IDENSTAT
+16 QUIT
ZET ;;ZET
+1 ;process Patient's Date Last Treated Event Type, ZET segment
+2 NEW PDLTET,IPP
+3 SET PDLTET=$PIECE(MSG,HL("FS"),2)
+4 SET $PIECE(MFI(ICN,INST,ZCNT),"^",2)=PDLTET
+5 ;DG*5.3*800 - Process In-Person Proofed
+6 ;In-Person Proofed
SET IPP=$PIECE(MSG,HL("FS"),3)
+7 SET $PIECE(MFI(ICN,INST,ZCNT),"^",6)=IPP
+8 QUIT
RSP ;response process logic entry point
+1 QUIT
ROUTE ;routing logic entry point
+1 NEW MPI
+2 SET MPI=$$MPILINK^MPIFAPI()
Begin DoDot:1
+3 IF $PIECE($GET(MPI),U)'=-1
SET HLL("LINKS",1)="VAFC MFN-M05 CLIENT"_"^"_MPI
+4 IF $PIECE($GET(MPI),U)=-1
Begin DoDot:2
+5 NEW RGLOG
DO START^RGHLLOG(HLMTIEN,"","")
+6 DO EXC^RGHLLOG(224,"No MPI link identified in CIRN SITE PARAMETER file (#991.8)",$GET(PDFN))
+7 DO STOP^RGHLLOG(0)
End DoDot:2
End DoDot:1
+8 QUIT
TEST ;
+1 WRITE $$REPROC^HLUTIL(39266,"D IN^VAFCTFIN")
+2 QUIT
RECONCIL ;
+1 NEW DFN,MFIC,VAFCX,VAFCY,TFL,CNFLT,LOCCMOR,VAFCTYPE,VAFCN,IDSTAT,SID
+2 SET CNFLT=0
+3 SET DFN=$$GETDFN^MPIF001(ICN)
+4 IF DFN'>0
SET CNFLT=1_"^"_$PIECE($GET(DFN),"^",2)
+5 IF MFUPT="REP"
IF +CNFLT=0
DO TFL^VAFCTFU1(.TFL,DFN)
SET VAFCX=0
FOR
SET VAFCX=$ORDER(TFL(VAFCX))
IF 'VAFCX
QUIT
Begin DoDot:1
+6 SET MFIC($PIECE(TFL(VAFCX),"^"))=TFL(VAFCX)
IF '$DATA(MFI(ICN,$PIECE(TFL(VAFCX),"^")))
DO DEL(ICN,$PIECE(TFL(VAFCX),"^"))
End DoDot:1
+7 ;VAFCX=ICN and VAFCY=INSTITUTION
+8 SET VAFCX=0
FOR
SET VAFCX=$ORDER(MFI(VAFCX))
IF 'VAFCX
QUIT
Begin DoDot:1
+9 SET VAFCY=0
FOR
SET VAFCY=$ORDER(MFI(VAFCX,VAFCY))
IF 'VAFCY
QUIT
Begin DoDot:2
+10 SET VAFCN=0
FOR
SET VAFCN=$ORDER(MFI(VAFCX,VAFCY,VAFCN))
IF 'VAFCN
QUIT
Begin DoDot:3
+11 SET VAFCTYPE=$PIECE(MFI(VAFCX,VAFCY,VAFCN),"^",3)
+12 SET SID=$PIECE(MFI(VAFCX,VAFCY,VAFCN),"^",7)
+13 SET IDSTAT=$PIECE(MFI(VAFCX,VAFCY,VAFCN),"^",8)
+14 IF +CNFLT=1
Begin DoDot:4
+15 SET MFA(VAFCY,VAFCN)="MFA"_HL("FS")_VAFCTYPE_HL("FS")_VAFCY_"-"_VAFCN_HL("FS")_$$HLDATE^HLFNC($$NOW^XLFDT)_HL("FS")_"U"_HLCOMP_$SELECT(VAFCTYPE="MDL":"Delete of ",1:"Update of ")
+16 SET MFA(VAFCY,VAFCN)=$GET(MFA(VAFCY,VAFCN))_VAFCY_" Failed at "_$PIECE($$SITE^VASITE,"^",3)_" due to "_$PIECE(CNFLT,"^",2)
End DoDot:4
+17 IF +CNFLT=0
IF VAFCTYPE="MAD"!(VAFCTYPE="MUP")!(VAFCTYPE="MDC")
DO ADDUPD(DFN,VAFCY,$PIECE(MFI(VAFCX,VAFCY,VAFCN),"^"),$PIECE(MFI(VAFCX,VAFCY,VAFCN),"^",2),$PIECE(MFI(VAFCX,VAFCY,VAFCN),"^",6),$GET(SID),$GET(IDSTAT),VAFCN,VAFCTYPE)
+18 IF +CNFLT=0
IF VAFCTYPE="MDL"
DO DEL(ICN,VAFCY,VAFCN)
End DoDot:3
End DoDot:2
End DoDot:1
+19 QUIT
ADDUPD(DFN,INST,PDLT,PDLRTET,IPP,DFNATST,IDENSTAT,ZCNT,VAFCTYPE) ;add or update TF entry
+1 NEW ERROR,STA
+2 SET STA=INST
+3 SET INST=$$LKUP^XUAF4(INST)
+4 IF INST=0
SET ERROR(STA)="Update of "_STA_" Failed at "_$PIECE($$SITE^VASITE,"^",3)_" due to unknown Institution IEN "_INST_" passed into TF update."
+5 IF '$DATA(ERROR(STA))
DO FILE^VAFCTFU(DFN,INST_"^"_$GET(PDLT)_"^"_$GET(PDLRTET),1,1,.ERROR,$GET(IPP),DFNATST,IDENSTAT)
+6 SET MFA(STA,ZCNT)="MFA"_HL("FS")_VAFCTYPE_HL("FS")_STA_"-"_ZCNT_HL("FS")_$$HLDATE^HLFNC($$NOW^XLFDT)_HL("FS")
+7 IF '$DATA(ERROR(STA))
SET MFA(STA,ZCNT)=MFA(STA,ZCNT)_"S"
+8 IF $DATA(ERROR(STA))
SET MFA(STA,ZCNT)=MFA(STA,ZCNT)_"U"_HLCOMP_ERROR(STA)_HL("FS")
+9 QUIT
DEL(ICN,INST) ;delete a TF entry
+1 NEW ERROR,STA
+2 SET STA=INST
+3 SET INST=$$LKUP^XUAF4(INST)
+4 SET ERROR=$$DELETETF^VAFCTFU(ICN,INST)
+5 ;**821 - No need to send MFA for entries that are deleted locally
+6 ;S MFA(STA,ZCNT)="MFA"_HL("FS")_"MDL"_HL("FS")_STA_"-"_ZCNT_HL("FS")_$$HLDATE^HLFNC($$NOW^XLFDT)_HL("FS")
+7 ;I +ERROR'=1 S MFA(STA,ZCNT)=MFA(STA,ZCNT)_"S"
+8 ;I +ERROR=1 S MFA(STA,ZCNT)=MFA(STA,ZCNT)_"U"_HLCOMP_"Delete Failed: "_$P(ERROR,"^",2)
+9 QUIT
