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

VAFCTFU.m

Go to the documentation of this file. 
  1. VAFCTFU ;ALB/JLU-UTILITIES FOR THE TREATING FACILITY FILE 391.91 ; 1/15/10 5:00pm
  1.  ;;5.3;PIMS;**149,240,261,255,316,392,440,428,474,520,697,1015,1016**;JUN 30, 2012;Build 20
  1.  ;
  1.  ;Reference to EXC^RGHLLOG and STOP^RGHLLOG supported by IA #2796
  1.  ;Reference to $$UPDATE^ MPIFAPI supported by IA #2706
  1.  ;
  1.  ;CHKSUB & GETSCN line tags removed, patch DG*5.3*697
  1.  ;Subscriptions are no longer used and errors are being
  1.  ;generated when attempting to add a subscription.
  1.  ;
  1. FILETF(PAT,INST) ;programmer entry point.
  1.  ;INPUT   PAT - This is the patient's ICN
  1.  ;       INST - This is the IEN of the institution or Treating Facility
  1.  ;it also contains the date of treatment in FM format.  It is to be
  1.  ;stored in an array structure to allow for multiple treating
  1.  ;facilities.
  1.  ;  EX.   X(1)=500^2960101
  1.  ;        x(2)=425^2960202
  1.  ;
  1.  ;OUTPUT  0 (ZERO) If no errors
  1.  ;        1^error description if there was an error.
  1.  ;
  1.  N PDFN,LP,VAFCER,X
  1.  S VAFCER=0
  1.  I '$G(PAT)!('$D(INST)) S VAFCER="1^Parameter missing." G FILETFQ
  1.  I $D(@INST)<10 S VAFCER="1^Institution array not populated." G FILETFQ
  1.  S X="MPIF001" X ^%ZOSF("TEST") I '$T G FILETFQ
  1.  S PDFN=$$GETDFN^MPIF001(PAT)
  1.  I PDFN<0 S VAFCER="1^No patient DFN." G FILETFQ
  1.  N FSTRG
  1.  F LP=0:0 S LP=$O(@INST@(LP)) Q:'LP  D FILE(PDFN,@INST@(LP))
  1.  ;
  1. FILETFQ Q VAFCER
  1.  ;
  1.  ; both the SET & QUERYTF subroutines have been moved to VAFCTFU1 as
  1.  ; the result of DG*5.3*261  *261 gjc@120899
  1.  ;
  1. FILE(PDFN,FSTRG,TICN,VAFCSLT,ERROR,IPP,SOURCEID,IDENSTAT) ;this module files the individual entry
  1.  ;PDFN is the patient's DFN
  1.  ;FSTRG = institution or treating facility^Date of treatment^Event reason
  1.  ;TICN - if 1 suppress add entries to ADT HL7 PIVOT (#391.71) file
  1.  ;VAFCSLT - (optional) if 1 suppress exception logging and return error in the ERROR array
  1.  ;ERROR - (optional) 
  1.  ;Ex  500^2960202^A1
  1.  ;
  1.  N X,Y
  1.  I $G(VAFCSLT)="" S VAFCSLT=0
  1.  S X="MPIF001" X ^%ZOSF("TEST") Q:'$T
  1.  S X="MPIFQ0" X ^%ZOSF("TEST") Q:'$T
  1.  N TFIEN,PDLT,FAC,EVNTR,VAFCER,CMOR,ICN,STA,ECNT
  1.  S ECNT=1
  1.  S FAC=$P(FSTRG,U,1),PDLT=$P(FSTRG,U,2),EVNTR=$P(FSTRG,U,3)
  1.  S STA=$$STA^XUAF4(FAC)
  1.  ;
  1.  I '$$FIND1^DIC(4,"","MX","`"_FAC) D  Q
  1.  . I 'VAFCSLT D EXC^RGHLLOG(212,"Msg#"_$G(HL("MID"))_" unknown Institution IEN "_FAC_" passed into TF update.",PDFN) D STOP^RGHLLOG(1) Q
  1.  . I VAFCSLT S ERROR(STA)="Update of "_STA_" Failed at "_$P($$SITE^VASITE,"^",3)_" due to unknown Institution IEN "_FAC_" passed into TF update."
  1.  I PDLT'="" K %DT S %DT="T" S X=PDLT D ^%DT K %DT I Y<0 S VAFCER="1^Not a FM date." D  Q
  1.  .I 'VAFCSLT D EXC^RGHLLOG(212,"TF updated in msg#"_$G(HL("MID"))_" for Institution IEN "_FAC_" but with invalid date "_PDLT_" for DFN "_PDFN,PDFN)
  1.  .I VAFCSLT S ERROR(STA)="Update of "_STA_" Failed at "_$P($$SITE^VASITE,"^",3)_" due to invalid date "_PDLT_" for DFN "_PDFN
  1.  ;removed code for adding local ICN's
  1.  S ICN=+$$MPINODE^MPIFAPI(PDFN)
  1.  S TFIEN=$O(^DGCN(391.91,"APAT",PDFN,FAC,0)) D
  1.  .;TFIEN is used in other places so quit after adding new entry
  1.  .I 'TFIEN D FILENEW(PDFN,FAC,PDLT,EVNTR,VAFCSLT,.ERROR,$G(IPP),$G(SOURCEID),$G(IDENSTAT)) Q
  1.  .I TFIEN D FILEDIT(TFIEN,PDLT,PDFN,FAC,EVNTR,VAFCSLT,.ERROR,$G(IPP),$G(SOURCEID),$G(IDENSTAT))
  1.  ;look to see if CMOR is in TF list if not add
  1.  S CMOR=$$GETVCCI^MPIF001(PDFN)
  1.  S CMOR=$$LKUP^XUAF4(CMOR) ; **520 REMOVED +
  1.  ;check to see if CMOR exist if not add it
  1.  I +$G(CMOR)>0 D:'$D(^DGCN(391.91,"APAT",PDFN,CMOR)) FILENEW^VAFCTFU(PDFN,CMOR)
  1.  ;create the entry in the pivot to broadcast the MFU.
  1.  ; Note: we will not broadcast to the MFU if the TFL record
  1.  ; has an event reason. See comments in FILEDIT. *261 gjc@120199
  1.  I $G(TICN)'=1,$P($$SEND^VAFHUTL,"^",2)>0 D SETSND(PDFN)
  1. FILEQ Q
  1.  ;
  1. FILENEW(PDFN,FAC,PDLT,EVNTR,VAFCSLT,ERROR,IPP,SOURCEID,IDENSTAT) ;
  1.  N DGSENFLG ;**240 added y
  1.  K DD,DO,DIC,DA,RESULT
  1.  S DGSENFLG=""
  1.  N FDA,FDAIEN,ERR S ERR=""
  1.  I $G(EVNTR)'="" D CHK^DIE(391.91,.07,"",EVNTR,.RESULT) I +RESULT>0 S EVNTR=RESULT
  1.  S FDA(1,391.91,"+1,",.01)=PDFN
  1.  S FDA(1,391.91,"+1,",.02)=FAC
  1.  S FDA(1,391.91,"+1,",.03)=$G(PDLT)
  1.  S FDA(1,391.91,"+1,",.07)=$G(EVNTR)
  1.  S FDA(1,391.91,"+1,",.08)=$G(IPP)
  1.  L +^DGCN(391.91,0):30
  1.  I '$D(^DGCN(391.91,"APAT",PDFN,FAC)) D UPDATE^DIE("","FDA(1)","FDAIEN","ERR") I $D(ERR("DIERR",1)) S ERROR(STA)="Add of "_STA_" Failed at "_$P($$SITE^VASITE,"^",3)_" due to "_$G(ERR("DIERR",1,"TEXT",1))
  1.  I $G(SOURCEID)'="",$G(FDAIEN(1))'="" D UPDSID(PDFN,FAC,SOURCEID,IDENSTAT,FDAIEN(1))  ;Update SourceID multiple
  1.  ;removed code to add a subscription
  1.  L -^DGCN(391.91,0)
  1.  K DIC,DD,DO,DA
  1.  Q
  1.  ;
  1. UPDSID(PDFN,FAC,SID,IDSTAT,TFIEN) ;Update sourceid multiple
  1.  N FDA,DGENDA,FILE,IENS
  1.  S FILE=391.9101
  1.  I $D(^DGCN(391.91,TFIEN,1,"B",SID)) D  Q  ;Update existing sub record
  1.  . S DGENDA=$O(^DGCN(391.91,TFIEN,1,"B",SID,0))
  1.  . S DGENDA(1)=TFIEN,IENS=$$IENS^DILF(.DGENDA)
  1.  . S FDA(FILE,IENS,.01)=SID,FDA(FILE,IENS,1)=IDSTAT
  1.  . D FILE^DIE("K","FDA","ERRORS(1)")
  1.  ;add new sub record
  1.  S DGENDA="+1",DGENDA(1)=TFIEN,IENS=$$IENS^DILF(.DGENDA)
  1.  S FDA(FILE,IENS,.01)=SID,FDA(FILE,IENS,1)=IDSTAT
  1.  D UPDATE^DIE("","FDA","IENA","ERRORS(1)")
  1.  Q
  1. SETSND(PDFN) ;sets the pivot file entry to send MFU
  1.  ;
  1.  N ANS,X
  1.  S X="MPIF001" X ^%ZOSF("TEST") Q:'$T
  1.  ; check if other facilities other than CMOR in TF list
  1.  N SIT,CMOR,STOP
  1.  S CMOR=$$GETVCCI^MPIF001(PDFN)
  1.  S CMOR=$$LKUP^XUAF4(CMOR) ; **520 REMOVED +
  1.  I CMOR=$P($$SITE^VASITE,"^") D
  1.  .S SIT=0
  1.  .S SIT=$O(^DGCN(391.91,"APAT",PDFN,SIT))
  1.  .I SIT=CMOR S SIT=$O(^DGCN(391.91,"APAT",PDFN,SIT)) I SIT="" S STOP=""
  1.  I $D(STOP) QUIT
  1.  S ANS=$$PIVNW^VAFHPIVT(PDFN,DT,5,PDFN_";DPT(")
  1.  I 'ANS QUIT
  1.  D XMITFLAG^VAFCDD01(0,+ANS,0)
  1. SETSNDQ Q
  1.  ;
  1. FILEDIT(TFIEN,PDLT,PDFN,FAC,EVNTR,VAFCSLT,ERROR,IPP,SOURCEID,IDENSTAT) ;
  1.  N DGSENFLG,FDA,FDAIEN,ERR,RESULT S DGSENFLG="",ERR=""
  1.  I $G(PDLT)'=""!($G(IPP)'="") D
  1.  .S TFIEN(0)=$G(^DGCN(391.91,TFIEN,0))
  1.  .I $G(EVNTR)'="" D CHK^DIE(391.91,.07,"",EVNTR,.RESULT) I +RESULT>0 S EVNTR=RESULT
  1.  .I $G(PDLT)'="" S FDA(1,391.91,+TFIEN_",",.03)=$G(PDLT)
  1.  .S FDA(1,391.91,+TFIEN_",",.07)=$G(EVNTR)
  1.  .I $G(IPP)'="" S FDA(1,391.91,+TFIEN_",",.08)=$G(IPP)
  1.  .D FILE^DIE("K","FDA(1)","ERR") I VAFCSLT I $D(ERR("DIERR",1)) S ERROR(STA)="Edit of "_STA_" Failed at "_$P($$SITE^VASITE,"^",3)_" due to "_$G(ERR("DIERR",1,"TEXT",1))
  1.  I $G(SOURCEID)'="" D UPDSID(PDFN,FAC,SOURCEID,IDENSTAT,TFIEN)
  1.  ;remove code to add a subscription
  1.  Q
  1.  ;
  1. DELETETF(PAT,INST) ;deletion entry point
  1.  ;This entry point is used to delete a single Treating Facility from
  1.  ;the Treating Facility list.
  1.  ;INPUT  PAT - the ICN of the patient.
  1.  ;       INST - the IEN of the institution to be deleted.
  1.  ;
  1.  ;OUTPUT  0 (zero) - If no errors
  1.  ;        1^error description if there was a problem
  1.  ;
  1.  N VAFCER,PDFN,TFIEN,X,VAFCSCN,LINK,VAFCLLN,IEN
  1.  S VAFCER=0
  1.  I '$G(PAT)!('$G(INST)) S VAFCER="1^Parameter missing." S ERROR(INST)="212"_"^"_$G(HL("MID"))_"^"_"Delete Failed: "_$P(VAFCER,"^") G DELTFQ
  1.  S X="MPIF001" X ^%ZOSF("TEST") I '$T G FILETFQ
  1.  S PDFN=$$GETDFN^MPIF001(+PAT)
  1.  I PDFN<0 S VAFCER="1^No patient DFN." G FILETFQ
  1.  I '$$FIND1^DIC(4,"","MX","`"_INST) S VAFCER="1^Not an Institution IEN." G DELTFQ
  1.  S TFIEN=$O(^DGCN(391.91,"APAT",PDFN,INST,0))
  1.  I 'TFIEN S VAFCER="1^Could not find Treating Facility." G DELTFQ
  1.  D DELETE(TFIEN)
  1.  S TFIEN=$O(^DGCN(391.91,"APAT",PDFN,INST,0))
  1.  I TFIEN S VAFCER="1^DIK failed to delete entry" G DELTFQ
  1.  ;terminate the subscription if there is one
  1.  S VAFCSCN=+$P($$MPINODE^MPIFAPI(PDFN),"^",5) I +$G(VAFCSCN)>0 D
  1.  .;get logical link
  1.  . D LINK^HLUTIL3(INST,.LINK) S VAFCLLN=$O(LINK(0)) I +$G(VAFCLLN)>0 S VAFCLLN=LINK(VAFCLLN) D UPD^HLSUB(VAFCSCN,VAFCLLN,0,,$$NOW^XLFDT,,.HLER)
  1.  D RETPDR^VAFCEHU2(PDFN,INST) ;**474 retire pdr when deleting tf
  1. DELTFQ Q VAFCER
  1.  ;
  1. DELETE(TFIEN) ;the actual deletion code
  1.  ;
  1.  K DIK,DA
  1.  S DIK="^DGCN(391.91,"
  1.  S DA=TFIEN
  1.  D ^DIK K DIK,DA
  1.  Q
  1.  ;
  1. DELALLTF(PAT) ;Entry point to delete all Treating Facilities for a single
  1.  ;patient.
  1.  ;INPUT  PAT - The patient's ICN
  1.  ;OUTPUT 0 (zero) - If no errors
  1.  ;       1^error description if an error
  1.  ;
  1.  N VAFCER,PDFN,LP,TFIEN,X
  1.  S VAFCER=0
  1.  I '$G(PAT) Q "1^Parameter missing."
  1.  S X="MPIF001" X ^%ZOSF("TEST") I '$T Q 0
  1.  S PDFN=$$GETDFN^MPIF001(PAT)
  1.  I PDFN<0 Q "1^No patient DFN."
  1.  F LP=0:0 S LP=$O(^DGCN(391.91,"APAT",PDFN,LP)) Q:LP'>0  D
  1.  . S TFIEN=0
  1.  . F  S TFIEN=$O(^DGCN(391.91,"APAT",PDFN,LP,TFIEN)) Q:TFIEN'>0  D DELETE(TFIEN)
  1.  ;
  1.  Q VAFCER
  1.  ;