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

VAFCOFIN.m

Go to the documentation of this file. 
  1. VAFCOFIN ;BIR/DR-TREATING FACILTIY MFU PROCESSING ROUTINE ; 2/1/10 12:46pm
  1.  ;;5.3;Registration;**821**;Aug 13, 1993;Build 7
  1.  ;Reference to EXC, START, and STOP^RGHLLOG supported by IA #2796
  1.  ;
  1.  ;***NOTE***
  1.  ;This routine is copy of original VAFCTFIN before DG*5.3*821
  1.  ;It is modified so VistA can process MFN~M05 in old format until
  1.  ;MPI starts sending new format.
  1.  ;
  1. 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
  1.  ;message is received.
  1.  ;There are no inputs or outputs
  1.  ;
  1.  I HL("MTN")="MFK" D RSP Q
  1.  N VAFC,STATN,VAFCI,MSG,SG,VAFCARR,PDFN,INST,MFUPT,PDLT,TFIEN
  1.  N ICN,MFI,MFE,MFA,HLCOMP,CNT,X,VAFCERR,VAFCX
  1.  ;quit if Master Patient Index (MPI) is not installed
  1.  S X="MPIF001" X ^%ZOSF("TEST") Q:'$T
  1.  S X="MPIFQ0" X ^%ZOSF("TEST") Q:'$T
  1.  S X="RGRSBUL1" X ^%ZOSF("TEST") Q:'$T
  1.  S X="RGRSBULL" X ^%ZOSF("TEST") Q:'$T
  1. INIT ;Process in the Treating Facility MFN msg
  1.  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
  1.  ;reconcil the inbound TF list from the MPI to the local TF list
  1.  D RECONCIL
  1.  ;create response message
  1.  S CNT=1
  1.  S HLA("HLA",1)="MSA"_HL("FS")_"AA"_HL("FS")_HL("MID")_HL("FS") S CNT=CNT+1
  1.  S HLA("HLA",CNT)=MFI S CNT=CNT+1
  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
  1.  ;generate an application level ack (MFK) identifying the status of the adds/edits/deletes of TF's passed in
  1.  D ROUTE
  1.  D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.VAFCERR,"",.HLP)
  1.  Q
  1. PICK ;check routine for segment entry point
  1.  I $T(@SG)]"" D @SG
  1.  I $T(@SG)="" Q
  1.  Q
  1. MSH ;;MSH
  1.  ;process the MSH segment
  1.  S (HLFS,HL("FS"))=$E(MSG,4),(HLECH,HL("ECH"))=$E(MSG,5,8)
  1.  S HLCOMP=$E(HL("ECH"),1)
  1.  S VAFCARR("SENDING SITE")=$P(MSG,HL("FS"),4)
  1.  Q
  1. EVN ;;EVN
  1.  ;process the EVN segment
  1.  S STATN=+$$SITE^VASITE()_"^"_$$FMDATE^HLFNC($P(MSG,HL("FS"),3))
  1.  Q
  1. PID ;;PID
  1.  ;process the PID segment
  1.  S PDFN=+$P(MSG,HL("FS"),4)
  1.  Q
  1. MFI ;;MFI
  1.  ;process the MFI segment
  1.  S MFI=MSG
  1.  S MFUPT=$P(MSG,HL("FS"),4)
  1.  S VAFCARR("CMOR")=$P($P(MSG,HL("FS"),8),$E(HL("ECH"),1))
  1.  Q
  1. MFE ;;MFE
  1.  ;process the MFE segment
  1.  N HLCOMP,NXTSGMT,TYPE
  1.  S HLCOMP=$E(HL("ECH"),1)
  1.  S PDLT=$$FMDATE^HLFNC($P(MSG,HL("FS"),4))
  1.  S ICN=$P($P(MSG,HL("FS"),5),HLCOMP,4)
  1.  S INST=$P($P(MSG,HL("FS"),5),HLCOMP)
  1.  S TYPE=$P(MSG,HL("FS"),2)
  1.  S MFE(INST)=MSG
  1.  S MFI(ICN,INST)=PDLT_"^^"_TYPE
  1.  Q
  1. ZET ;;ZET
  1.  ;process Patient's Date Last Treated Event Type, ZET segment
  1.  N PDLTET,IPP
  1.  S PDLTET=$P(MSG,HL("FS"),2)
  1.  S $P(MFI(ICN,INST),"^",2)=PDLTET
  1.  ;DG*5.3*800 - Process In-Person Proofed
  1.  S IPP=$P(MSG,HL("FS"),3) ;In-Person Proofed
  1.  S $P(MFI(ICN,INST),"^",6)=IPP
  1.  Q
  1. RSP ;response process logic entry point
  1.  Q
  1. ROUTE ;routing logic entry point
  1.  N MPI
  1.  S MPI=$$MPILINK^MPIFAPI() D
  1.  .I $P($G(MPI),U)'=-1 S HLL("LINKS",1)="VAFC MFN-M05 CLIENT"_"^"_MPI
  1.  .I $P($G(MPI),U)=-1 D
  1.  .. N RGLOG D START^RGHLLOG(HLMTIEN,"","")
  1.  .. D EXC^RGHLLOG(224,"No MPI link identified in CIRN SITE PARAMETER file (#991.8)",$G(PDFN))
  1.  .. D STOP^RGHLLOG(0)
  1.  Q
  1. TEST ;
  1.  W $$REPROC^HLUTIL(39266,"D IN^VAFCTFIN")
  1.  Q
  1. RECONCIL ;
  1.  N DFN,MFIC,VAFCX,VAFCY,TFL,CNFLT,LOCCMOR,VAFCTYPE
  1.  S CNFLT=0
  1.  S DFN=$$GETDFN^MPIF001(ICN)
  1.  I DFN'>0 S CNFLT=1_"^"_$P($G(DFN),"^",2)
  1.  I MFUPT="REP" I +CNFLT=0 D TFL^VAFCTFU1(.TFL,DFN) S VAFCX=0 F  S VAFCX=$O(TFL(VAFCX)) Q:'VAFCX  D
  1.  . S MFIC($P(TFL(VAFCX),"^"))=TFL(VAFCX) I '$D(MFI(ICN,$P(TFL(VAFCX),"^"))) D DEL(ICN,$P(TFL(VAFCX),"^"))
  1.  ;VAFCX=ICN and VAFCY=INSTITUTION
  1.  S VAFCX=0 F  S VAFCX=$O(MFI(VAFCX)) Q:'VAFCX  D
  1.  . S VAFCY=0 F  S VAFCY=$O(MFI(VAFCX,VAFCY)) Q:'VAFCY  D
  1.  ..S VAFCTYPE=$P(MFI(VAFCX,VAFCY),"^",3)
  1.  ..I +CNFLT=1 S MFA(VAFCY)="MFA"_HL("FS")_VAFCTYPE_HL("FS")_VAFCY_HL("FS")_$$HLDATE^HLFNC($$NOW^XLFDT)_HL("FS")_"U"_HLCOMP_$S(VAFCTYPE="MDL":"Delete of ",1:"Update of ")_VAFCY_" Failed at "_$P($$SITE^VASITE,"^",3)_" due to "_$P(CNFLT,"^",2)
  1.  ..I +CNFLT=0 I VAFCTYPE="MAD"!(VAFCTYPE="MUP") D ADDUPD(DFN,VAFCY,$P(MFI(VAFCX,VAFCY),"^"),$P(MFI(VAFCX,VAFCY),"^",2),$P(MFI(VAFCX,VAFCY),"^",6))
  1.  ..I +CNFLT=0 I VAFCTYPE="MDL" D DEL(ICN,VAFCY)
  1.  Q
  1. ADDUPD(DFN,INST,PDLT,PDLRTET,IPP) ;add or update TF entry
  1.  N ERROR,STA
  1.  S STA=INST
  1.  S INST=$$LKUP^XUAF4(INST)
  1.  D FILE^VAFCOTFU(DFN,INST_"^"_$G(PDLT)_"^"_$G(PDLRTET),1,1,.ERROR,$G(IPP))
  1.  S MFA(STA)="MFA"_HL("FS")_"MUP"_HL("FS")_STA_HL("FS")_$$HLDATE^HLFNC($$NOW^XLFDT)_HL("FS")
  1.  I '$D(ERROR(STA)) S MFA(STA)=MFA(STA)_"S"
  1.  I $D(ERROR(STA)) S MFA(STA)=MFA(STA)_"U"_HLCOMP_ERROR(STA)_HL("FS")
  1.  Q
  1. DEL(ICN,INST) ;delete a TF entry
  1.  N ERROR,STA
  1.  S STA=INST
  1.  S INST=$$LKUP^XUAF4(INST)
  1.  S ERROR=$$DELETETF^VAFCOTFU(ICN,INST)
  1.  S MFA(STA)="MFA"_HL("FS")_"MDL"_HL("FS")_STA_HL("FS")_$$HLDATE^HLFNC($$NOW^XLFDT)_HL("FS")
  1.  I +ERROR'=1 S MFA(STA)=MFA(STA)_"S"
  1.  I +ERROR=1 S MFA(STA)=MFA(STA)_"U"_HLCOMP_"Delete Failed: "_$P(ERROR,"^",2)
  1.  Q