VAFCTFU ;ALB/JLU-UTILITIES FOR THE TREATING FACILITY FILE 391.91 ; 5/23/12 12:58pm
;;5.3;Registration;**149,240,261,255,316,392,440,428,474,520,697,800,821,837,856,1079**;Aug 13, 1993;Build 2
;
;Reference to EXC^RGHLLOG and STOP^RGHLLOG supported by IA #2796
;Reference to $$UPDATE^ MPIFAPI supported by IA #2706
;
;CHKSUB & GETSCN line tags removed, patch DG*5.3*697
;Subscriptions are no longer used and errors are being
;generated when attempting to add a subscription.
;
FILETF(PAT,INST) ;programmer entry point.
;INPUT PAT - This is the patient's ICN
; INST - This is the IEN of the institution or Treating Facility
;it also contains the date of treatment in FM format. It is to be
;stored in an array structure to allow for multiple treating
;facilities.
; EX. X(1)=500^2960101
; x(2)=425^2960202
;
;OUTPUT 0 (ZERO) If no errors
; 1^error description if there was an error.
;
N PDFN,LP,VAFCER,X
S VAFCER=0
I '$G(PAT)!('$D(INST)) S VAFCER="1^Parameter missing." G FILETFQ
I $D(@INST)<10 S VAFCER="1^Institution array not populated." G FILETFQ
S X="MPIF001" X ^%ZOSF("TEST") I '$T G FILETFQ
S PDFN=$$GETDFN^MPIF001(PAT)
I PDFN<0 S VAFCER="1^No patient DFN." G FILETFQ
N FSTRG
F LP=0:0 S LP=$O(@INST@(LP)) Q:'LP D FILE(PDFN,@INST@(LP))
;
FILETFQ Q VAFCER
;
; both the SET & QUERYTF subroutines have been moved to VAFCTFU1 as
; the result of DG*5.3*261 *261 gjc@120899
;
FILE(PDFN,FSTRG,TICN,VAFCSLT,ERROR,IPP,SOURCEID,IDENSTAT,AA,IDTYP) ;this module files the individual entry
;W KKKKK
;PDFN is the patient's DFN
;FSTRG = institution or treating facility^Date of treatment^Event reason
;TICN - if 1 suppress add entries to ADT HL7 PIVOT (#391.71) file
;VAFCSLT - (optional) if 1 suppress exception logging and return error in the ERROR array
;ERROR - (optional)
;Ex 500^2960202^A1
;
N X,Y,TMPFLG
I $G(VAFCSLT)="" S VAFCSLT=0
S X="MPIF001" X ^%ZOSF("TEST") Q:'$T
S X="MPIFQ0" X ^%ZOSF("TEST") Q:'$T
N TFIEN,PDLT,FAC,EVNTR,VAFCER,CMOR,ICN,STA,ECNT
S ECNT=1
S FAC=$P(FSTRG,U,1),PDLT=$P(FSTRG,U,2),EVNTR=$P(FSTRG,U,3)
S STA=$$STA^XUAF4(FAC)
;
I '$$FIND1^DIC(4,"","MX","`"_FAC) D Q
. I 'VAFCSLT D EXC^RGHLLOG(212,"Msg#"_$G(HL("MID"))_" unknown Institution IEN "_FAC_" passed into TF update.",PDFN) D STOP^RGHLLOG(1) Q
. I VAFCSLT S ERROR(STA)="Update of "_STA_" Failed at "_$P($$SITE^VASITE,"^",3)_" due to unknown Institution IEN "_FAC_" passed into TF update."
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
.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)
.I VAFCSLT S ERROR(STA)="Update of "_STA_" Failed at "_$P($$SITE^VASITE,"^",3)_" due to invalid date "_PDLT_" for DFN "_PDFN
;**856 - MVI 1371 (ckn)
;Default assigning authority and Id type if not passed in as parameter
I $$GET1^DIQ(4,FAC_",",13,"E")'="OTHER" D
. I $G(AA)="" S AA="USVHA"
. I $G(IDTYP)="" S IDTYP="PI"
I $$STA^XUAF4(FAC)="200DOD" S AA="USDOD",IDTYP="NI"
;Quit if incoming values are null for Source ID, AA, ID Type and Identifier Status. We do not want to create or update entry.
;I $G(SOURCEID)="",$G(IDENSTAT)="",$G(AA)="",$G(IDTYP)="" Q
;removed code for adding local ICN's
S ICN=+$$MPINODE^MPIFAPI(PDFN)
;**837 - MVI_791 (ckn) - Loop through all existing entries for TF to decide to update or add after comparing incoming values.
;S TFIEN=$O(^DGCN(391.91,"APAT",PDFN,FAC,0)) D
S TMPFLG=0
S TFIEN=0 F S TFIEN=$O(^DGCN(391.91,"APAT",PDFN,FAC,TFIEN)) Q:+TFIEN=0!(TMPFLG) D
.;TFIEN is used in other places so quit after adding new entry
.;**837 - MVI_791 (ckn)
.I 'TFIEN Q
.N TMPAA,TMPIDTYP,TMPSID,TMPIDST
.;GET EXISTING FIELDS TO COMPARE WITH INCOMING VALUES
.S TMPAA=$P($G(^DGCN(391.91,TFIEN,2)),"^") ;Existing Assigning Authority
.S TMPIDTYP=$P($G(^DGCN(391.91,TFIEN,0)),"^",9) ;Existing IDtype
.S TMPSID=$P($G(^DGCN(391.91,TFIEN,2)),"^",2) ;Existing Source ID
.S TMPIDST=$P($G(^DGCN(391.91,TFIEN,2)),"^",3) ;Existing Identifier Status
.;NOW COMPARE INCOMING FIELDS AND EXISTING FIELDS TO DETERMINE UNIQUE ENTRY
.I TMPAA=$G(AA),TMPIDTYP=$G(IDTYP),TMPSID=$G(SOURCEID),TMPIDST=$G(IDENSTAT) S TMPFLG=1
.I TMPFLG D FILEDIT(TFIEN,PDLT,PDFN,FAC,EVNTR,VAFCSLT,.ERROR,$G(IPP),$G(SOURCEID),$G(IDENSTAT),$G(AA),$G(IDTYP))
I 'TMPFLG D FILENEW(PDFN,FAC,PDLT,EVNTR,VAFCSLT,.ERROR,$G(IPP),$G(SOURCEID),$G(IDENSTAT),$G(AA),$G(IDTYP)) Q
;look to see if CMOR is in TF list if not add
;S CMOR=$$GETVCCI^MPIF001(PDFN)
;S CMOR=$$LKUP^XUAF4(CMOR) ; **520 REMOVED +
;check to see if CMOR exist if not add it
;MVI-791 (ckn) - no need to check for CMOR and add new
;I +$G(CMOR)>0 D:'$D(^DGCN(391.91,"APAT",PDFN,CMOR)) FILENEW^VAFCTFU(PDFN,CMOR)
;create the entry in the pivot to broadcast the MFU.
; Note: we will not broadcast to the MFU if the TFL record
; has an event reason. See comments in FILEDIT. *261 gjc@120199
I $G(TICN)'=1,$P($$SEND^VAFHUTL,"^",2)>0 D SETSND(PDFN)
FILEQ Q
;
FILENEW(PDFN,FAC,PDLT,EVNTR,VAFCSLT,ERROR,IPP,SOURCEID,IDENSTAT,AA,IDTYP) ;
N DGSENFLG ;**240 added y
K DD,DO,DIC,DA,RESULT,DGRSLT
S DGSENFLG=""
N FDA,FDAIEN,ERR S ERR=""
I $G(EVNTR)'="" D CHK^DIE(391.91,.07,"",EVNTR,.RESULT) I +RESULT>0 S EVNTR=RESULT
S FDA(1,391.91,"+1,",.01)=PDFN
S FDA(1,391.91,"+1,",.02)=FAC
S FDA(1,391.91,"+1,",.03)=$G(PDLT)
S FDA(1,391.91,"+1,",.07)=$G(EVNTR)
S FDA(1,391.91,"+1,",.08)=$G(IPP)
;**837 - MVI_791 (ckn)
S FDA(1,391.91,"+1,",10)=$G(AA) ;Assigning Authority
S FDA(1,391.91,"+1,",.09)=$G(IDTYP) ;Source Id Type
S FDA(1,391.91,"+1,",11)=$G(SOURCEID) ;Source ID
S FDA(1,391.91,"+1,",12)=$G(IDENSTAT) ;Identifier Status
L +^DGCN(391.91,0):30
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))
;**837 (ckn) - MVI_791 - No more Source ID multiple
;I $G(SOURCEID)'="",$G(FDAIEN(1))'="" D UPDSID(PDFN,FAC,SOURCEID,IDENSTAT,FDAIEN(1)) ;Update SourceID multiple
;removed code to add a subscription
;**1079 CALL PTF QUERY FOR CORRELATION BEING ADDED - JUST VISTA's include Cerner (all flavors), not station 200, Not local station at and only for PATIENTS (PI)
I $$GET1^DIQ(4,FAC_",",13)'="OTHER"&($$STA^XUAF4(FAC)'=200)&($$STA^XUAF4(FAC)'=$P($$SITE^VASITE(),"^",3))&($G(IDTYP)="PI") S DGRSLT=$$SNDQRY^DGPFHLS(PDFN,$$QRYON^DGPFPARM(),$$STA^XUAF4(FAC))
L -^DGCN(391.91,0)
K DIC,DD,DO,DA
Q
;
UPDSID(PDFN,FAC,SID,IDSTAT,TFIEN) ;Update sourceid multiple
N FDA,DGENDA,FILE,IENS
S FILE=391.9101
I $D(^DGCN(391.91,TFIEN,1,"B",SID)) D Q ;Update existing sub record
. S DGENDA=$O(^DGCN(391.91,TFIEN,1,"B",SID,0))
. S DGENDA(1)=TFIEN,IENS=$$IENS^DILF(.DGENDA)
. S FDA(FILE,IENS,.01)=SID,FDA(FILE,IENS,1)=IDSTAT
. D FILE^DIE("K","FDA","ERRORS(1)")
;add new sub record
S DGENDA="+1",DGENDA(1)=TFIEN,IENS=$$IENS^DILF(.DGENDA)
S FDA(FILE,IENS,.01)=SID,FDA(FILE,IENS,1)=IDSTAT
D UPDATE^DIE("","FDA","IENA","ERRORS(1)")
Q
SETSND(PDFN) ;sets the pivot file entry to send MFU
;
N ANS,X
S X="MPIF001" X ^%ZOSF("TEST") Q:'$T
; check if other facilities other than CMOR in TF list
N SIT,CMOR,STOP
S CMOR=$$GETVCCI^MPIF001(PDFN)
S CMOR=$$LKUP^XUAF4(CMOR) ; **520 REMOVED +
I CMOR=$P($$SITE^VASITE,"^") D
.S SIT=0
.S SIT=$O(^DGCN(391.91,"APAT",PDFN,SIT))
.I SIT=CMOR S SIT=$O(^DGCN(391.91,"APAT",PDFN,SIT)) I SIT="" S STOP=""
I $D(STOP) QUIT
S ANS=$$PIVNW^VAFHPIVT(PDFN,DT,5,PDFN_";DPT(")
I 'ANS QUIT
D XMITFLAG^VAFCDD01(0,+ANS,0)
SETSNDQ Q
;
FILEDIT(TFIEN,PDLT,PDFN,FAC,EVNTR,VAFCSLT,ERROR,IPP,SOURCEID,IDENSTAT,AA,IDTYP) ;
N DGSENFLG,FDA,FDAIEN,ERR,RESULT S DGSENFLG="",ERR=""
I $G(PDLT)'=""!($G(IPP)'="")!($G(AA)'="")!($G(IDTYP)'="")!($G(SOURCEID)'="")!($G(IDENSTAT)'="") D
.S TFIEN(0)=$G(^DGCN(391.91,TFIEN,0))
.I $G(EVNTR)'="" D CHK^DIE(391.91,.07,"",EVNTR,.RESULT) I +RESULT>0 S EVNTR=RESULT
.I $G(PDLT)'="" S FDA(1,391.91,+TFIEN_",",.03)=$G(PDLT)
.S FDA(1,391.91,+TFIEN_",",.07)=$G(EVNTR)
.I $G(IPP)'="" S FDA(1,391.91,+TFIEN_",",.08)=$G(IPP)
.;**837 - MVI_791 (ckn)
.I $G(AA)'="" S FDA(1,391.91,+TFIEN_",",10)=$G(AA)
.I $G(IDTYP)'="" S FDA(1,391.91,+TFIEN_",",.09)=$G(IDTYP)
.I $G(SOURCEID)'="" S FDA(1,391.91,+TFIEN_",",11)=$G(SOURCEID)
.I $G(IDENSTAT)'="" S FDA(1,391.91,+TFIEN_",",12)=$G(IDENSTAT)
.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))
;**837 - MVI_791 (ckn) - no more updates to multiples
;I $G(SOURCEID)'="" D UPDSID(PDFN,FAC,SOURCEID,IDENSTAT,TFIEN)
;remove code to add a subscription
Q
;
DELETETF(PAT,INST,DTIEN) ;deletion entry point
;This entry point is used to delete a single Treating Facility from
;the Treating Facility list.
;**837 - MVI_791 (ckn) - Now we will have multiple entries in TF file so it is determined which entry to be deleted before calling this api. Hence, Treating Facility IEN is passed in. Unused code is commented out.
;INPUT PAT - the ICN of the patient.
; INST - the IEN of the institution to be deleted.
; DTIEN - the IEN of Treating Facility file
;OUTPUT 0 (zero) - If no errors
; 1^error description if there was a problem
;
;**837 v4 MVI 791 (ckn) - check if DTIEN is passed
I $G(DTIEN)="" Q "-1^DTIEN - IEN of Treating Facility not defined"
N VAFCER,PDFN,TFIEN,X,VAFCSCN,LINK,VAFCLLN,IEN
S VAFCER=0
I '$G(PAT)!('$G(INST)) S VAFCER="1^Parameter missing." S ERROR(INST)="212"_"^"_$G(HL("MID"))_"^"_"Delete Failed: "_$P(VAFCER,"^") G DELTFQ
S X="MPIF001" X ^%ZOSF("TEST") I '$T G FILETFQ
S PDFN=$$GETDFN^MPIF001(+PAT)
I PDFN<0 S VAFCER="1^No patient DFN." G FILETFQ
I '$$FIND1^DIC(4,"","MX","`"_INST) S VAFCER="1^Not an Institution IEN." G DELTFQ
I '$D(^DGCN(391.91,DTIEN)) S VAFCER="1^Could not find Treating Facility." G DELTFQ
D DELETE(DTIEN)
I $D(^DGCN(391.91,DTIEN)) S VAFCER="1^DIK failed to delete entry" G DELTFQ
;terminate the subscription if there is one
S VAFCSCN=+$P($$MPINODE^MPIFAPI(PDFN),"^",5) I +$G(VAFCSCN)>0 D
.;get logical link
. 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)
;**837 - MVI_791 (ckn) - no need to retire pdr anymore as it is not used
;D RETPDR^VAFCEHU2(PDFN,INST) ;**474 retire pdr when deleting tf
DELTFQ Q VAFCER
;
DELETE(TFIEN) ;the actual deletion code
;
K DIK,DA
S DIK="^DGCN(391.91,"
S DA=TFIEN
D ^DIK K DIK,DA
Q
;
DELALLTF(PAT) ;Entry point to delete all Treating Facilities for a single patient.
;INPUT PAT - The patient's ICN
;OUTPUT 0 (zero) - If no errors
; 1^error description if an error
;
N VAFCER,PDFN,LP,TFIEN,X
S VAFCER=0
I '$G(PAT) Q "1^Parameter missing."
S X="MPIF001" X ^%ZOSF("TEST") I '$T Q 0
S PDFN=$$GETDFN^MPIF001(PAT)
I PDFN<0 Q "1^No patient DFN."
F LP=0:0 S LP=$O(^DGCN(391.91,"APAT",PDFN,LP)) Q:LP'>0 D
.S TFIEN=0 F S TFIEN=$O(^DGCN(391.91,"APAT",PDFN,LP,TFIEN)) Q:TFIEN'>0 D DELETE(TFIEN)
;
Q VAFCER
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFCTFU 11251 printed Dec 13, 2024@03:02:29 Page 2
VAFCTFU ;ALB/JLU-UTILITIES FOR THE TREATING FACILITY FILE 391.91 ; 5/23/12 12:58pm
+1 ;;5.3;Registration;**149,240,261,255,316,392,440,428,474,520,697,800,821,837,856,1079**;Aug 13, 1993;Build 2
+2 ;
+3 ;Reference to EXC^RGHLLOG and STOP^RGHLLOG supported by IA #2796
+4 ;Reference to $$UPDATE^ MPIFAPI supported by IA #2706
+5 ;
+6 ;CHKSUB & GETSCN line tags removed, patch DG*5.3*697
+7 ;Subscriptions are no longer used and errors are being
+8 ;generated when attempting to add a subscription.
+9 ;
FILETF(PAT,INST) ;programmer entry point.
+1 ;INPUT PAT - This is the patient's ICN
+2 ; INST - This is the IEN of the institution or Treating Facility
+3 ;it also contains the date of treatment in FM format. It is to be
+4 ;stored in an array structure to allow for multiple treating
+5 ;facilities.
+6 ; EX. X(1)=500^2960101
+7 ; x(2)=425^2960202
+8 ;
+9 ;OUTPUT 0 (ZERO) If no errors
+10 ; 1^error description if there was an error.
+11 ;
+12 NEW PDFN,LP,VAFCER,X
+13 SET VAFCER=0
+14 IF '$GET(PAT)!('$DATA(INST))
SET VAFCER="1^Parameter missing."
GOTO FILETFQ
+15 IF $DATA(@INST)<10
SET VAFCER="1^Institution array not populated."
GOTO FILETFQ
+16 SET X="MPIF001"
XECUTE ^%ZOSF("TEST")
IF '$TEST
GOTO FILETFQ
+17 SET PDFN=$$GETDFN^MPIF001(PAT)
+18 IF PDFN<0
SET VAFCER="1^No patient DFN."
GOTO FILETFQ
+19 NEW FSTRG
+20 FOR LP=0:0
SET LP=$ORDER(@INST@(LP))
if 'LP
QUIT
DO FILE(PDFN,@INST@(LP))
+21 ;
FILETFQ QUIT VAFCER
+1 ;
+2 ; both the SET & QUERYTF subroutines have been moved to VAFCTFU1 as
+3 ; the result of DG*5.3*261 *261 gjc@120899
+4 ;
FILE(PDFN,FSTRG,TICN,VAFCSLT,ERROR,IPP,SOURCEID,IDENSTAT,AA,IDTYP) ;this module files the individual entry
+1 ;W KKKKK
+2 ;PDFN is the patient's DFN
+3 ;FSTRG = institution or treating facility^Date of treatment^Event reason
+4 ;TICN - if 1 suppress add entries to ADT HL7 PIVOT (#391.71) file
+5 ;VAFCSLT - (optional) if 1 suppress exception logging and return error in the ERROR array
+6 ;ERROR - (optional)
+7 ;Ex 500^2960202^A1
+8 ;
+9 NEW X,Y,TMPFLG
+10 IF $GET(VAFCSLT)=""
SET VAFCSLT=0
+11 SET X="MPIF001"
XECUTE ^%ZOSF("TEST")
if '$TEST
QUIT
+12 SET X="MPIFQ0"
XECUTE ^%ZOSF("TEST")
if '$TEST
QUIT
+13 NEW TFIEN,PDLT,FAC,EVNTR,VAFCER,CMOR,ICN,STA,ECNT
+14 SET ECNT=1
+15 SET FAC=$PIECE(FSTRG,U,1)
SET PDLT=$PIECE(FSTRG,U,2)
SET EVNTR=$PIECE(FSTRG,U,3)
+16 SET STA=$$STA^XUAF4(FAC)
+17 ;
+18 IF '$$FIND1^DIC(4,"","MX","`"_FAC)
Begin DoDot:1
+19 IF 'VAFCSLT
DO EXC^RGHLLOG(212,"Msg#"_$GET(HL("MID"))_" unknown Institution IEN "_FAC_" passed into TF update.",PDFN)
DO STOP^RGHLLOG(1)
QUIT
+20 IF VAFCSLT
SET ERROR(STA)="Update of "_STA_" Failed at "_$PIECE($$SITE^VASITE,"^",3)_" due to unknown Institution IEN "_FAC_" passed into TF update."
End DoDot:1
QUIT
+21 IF PDLT'=""
KILL %DT
SET %DT="T"
SET X=PDLT
DO ^%DT
KILL %DT
IF Y<0
SET VAFCER="1^Not a FM date."
Begin DoDot:1
+22 IF 'VAFCSLT
DO EXC^RGHLLOG(212,"TF updated in msg#"_$GET(HL("MID"))_" for Institution IEN "_FAC_" but with invalid date "_PDLT_" for DFN "_PDFN,PDFN)
+23 IF VAFCSLT
SET ERROR(STA)="Update of "_STA_" Failed at "_$PIECE($$SITE^VASITE,"^",3)_" due to invalid date "_PDLT_" for DFN "_PDFN
End DoDot:1
QUIT
+24 ;**856 - MVI 1371 (ckn)
+25 ;Default assigning authority and Id type if not passed in as parameter
+26 IF $$GET1^DIQ(4,FAC_",",13,"E")'="OTHER"
Begin DoDot:1
+27 IF $GET(AA)=""
SET AA="USVHA"
+28 IF $GET(IDTYP)=""
SET IDTYP="PI"
End DoDot:1
+29 IF $$STA^XUAF4(FAC)="200DOD"
SET AA="USDOD"
SET IDTYP="NI"
+30 ;Quit if incoming values are null for Source ID, AA, ID Type and Identifier Status. We do not want to create or update entry.
+31 ;I $G(SOURCEID)="",$G(IDENSTAT)="",$G(AA)="",$G(IDTYP)="" Q
+32 ;removed code for adding local ICN's
+33 SET ICN=+$$MPINODE^MPIFAPI(PDFN)
+34 ;**837 - MVI_791 (ckn) - Loop through all existing entries for TF to decide to update or add after comparing incoming values.
+35 ;S TFIEN=$O(^DGCN(391.91,"APAT",PDFN,FAC,0)) D
+36 SET TMPFLG=0
+37 SET TFIEN=0
FOR
SET TFIEN=$ORDER(^DGCN(391.91,"APAT",PDFN,FAC,TFIEN))
if +TFIEN=0!(TMPFLG)
QUIT
Begin DoDot:1
+38 ;TFIEN is used in other places so quit after adding new entry
+39 ;**837 - MVI_791 (ckn)
+40 IF 'TFIEN
QUIT
+41 NEW TMPAA,TMPIDTYP,TMPSID,TMPIDST
+42 ;GET EXISTING FIELDS TO COMPARE WITH INCOMING VALUES
+43 ;Existing Assigning Authority
SET TMPAA=$PIECE($GET(^DGCN(391.91,TFIEN,2)),"^")
+44 ;Existing IDtype
SET TMPIDTYP=$PIECE($GET(^DGCN(391.91,TFIEN,0)),"^",9)
+45 ;Existing Source ID
SET TMPSID=$PIECE($GET(^DGCN(391.91,TFIEN,2)),"^",2)
+46 ;Existing Identifier Status
SET TMPIDST=$PIECE($GET(^DGCN(391.91,TFIEN,2)),"^",3)
+47 ;NOW COMPARE INCOMING FIELDS AND EXISTING FIELDS TO DETERMINE UNIQUE ENTRY
+48 IF TMPAA=$GET(AA)
IF TMPIDTYP=$GET(IDTYP)
IF TMPSID=$GET(SOURCEID)
IF TMPIDST=$GET(IDENSTAT)
SET TMPFLG=1
+49 IF TMPFLG
DO FILEDIT(TFIEN,PDLT,PDFN,FAC,EVNTR,VAFCSLT,.ERROR,$GET(IPP),$GET(SOURCEID),$GET(IDENSTAT),$GET(AA),$GET(IDTYP))
End DoDot:1
+50 IF 'TMPFLG
DO FILENEW(PDFN,FAC,PDLT,EVNTR,VAFCSLT,.ERROR,$GET(IPP),$GET(SOURCEID),$GET(IDENSTAT),$GET(AA),$GET(IDTYP))
QUIT
+51 ;look to see if CMOR is in TF list if not add
+52 ;S CMOR=$$GETVCCI^MPIF001(PDFN)
+53 ;S CMOR=$$LKUP^XUAF4(CMOR) ; **520 REMOVED +
+54 ;check to see if CMOR exist if not add it
+55 ;MVI-791 (ckn) - no need to check for CMOR and add new
+56 ;I +$G(CMOR)>0 D:'$D(^DGCN(391.91,"APAT",PDFN,CMOR)) FILENEW^VAFCTFU(PDFN,CMOR)
+57 ;create the entry in the pivot to broadcast the MFU.
+58 ; Note: we will not broadcast to the MFU if the TFL record
+59 ; has an event reason. See comments in FILEDIT. *261 gjc@120199
+60 IF $GET(TICN)'=1
IF $PIECE($$SEND^VAFHUTL,"^",2)>0
DO SETSND(PDFN)
FILEQ QUIT
+1 ;
FILENEW(PDFN,FAC,PDLT,EVNTR,VAFCSLT,ERROR,IPP,SOURCEID,IDENSTAT,AA,IDTYP) ;
+1 ;**240 added y
NEW DGSENFLG
+2 KILL DD,DO,DIC,DA,RESULT,DGRSLT
+3 SET DGSENFLG=""
+4 NEW FDA,FDAIEN,ERR
SET ERR=""
+5 IF $GET(EVNTR)'=""
DO CHK^DIE(391.91,.07,"",EVNTR,.RESULT)
IF +RESULT>0
SET EVNTR=RESULT
+6 SET FDA(1,391.91,"+1,",.01)=PDFN
+7 SET FDA(1,391.91,"+1,",.02)=FAC
+8 SET FDA(1,391.91,"+1,",.03)=$GET(PDLT)
+9 SET FDA(1,391.91,"+1,",.07)=$GET(EVNTR)
+10 SET FDA(1,391.91,"+1,",.08)=$GET(IPP)
+11 ;**837 - MVI_791 (ckn)
+12 ;Assigning Authority
SET FDA(1,391.91,"+1,",10)=$GET(AA)
+13 ;Source Id Type
SET FDA(1,391.91,"+1,",.09)=$GET(IDTYP)
+14 ;Source ID
SET FDA(1,391.91,"+1,",11)=$GET(SOURCEID)
+15 ;Identifier Status
SET FDA(1,391.91,"+1,",12)=$GET(IDENSTAT)
+16 LOCK +^DGCN(391.91,0):30
+17 DO UPDATE^DIE("","FDA(1)","FDAIEN","ERR")
IF $DATA(ERR("DIERR",1))
SET ERROR(STA)="Add of "_STA_" Failed at "_$PIECE($$SITE^VASITE,"^",3)_" due to "_$GET(ERR("DIERR",1,"TEXT",1))
+18 ;**837 (ckn) - MVI_791 - No more Source ID multiple
+19 ;I $G(SOURCEID)'="",$G(FDAIEN(1))'="" D UPDSID(PDFN,FAC,SOURCEID,IDENSTAT,FDAIEN(1)) ;Update SourceID multiple
+20 ;removed code to add a subscription
+21 ;**1079 CALL PTF QUERY FOR CORRELATION BEING ADDED - JUST VISTA's include Cerner (all flavors), not station 200, Not local station at and only for PATIENTS (PI)
+22 IF $$GET1^DIQ(4,FAC_",",13)'="OTHER"&($$STA^XUAF4(FAC)'=200)&($$STA^XUAF4(FAC)'=$PIECE($$SITE^VASITE(),"^",3))&($GET(IDTYP)="PI")
SET DGRSLT=$$SNDQRY^DGPFHLS(PDFN,$$QRYON^DGPFPARM(),$$STA^XUAF4(FAC))
+23 LOCK -^DGCN(391.91,0)
+24 KILL DIC,DD,DO,DA
+25 QUIT
+26 ;
UPDSID(PDFN,FAC,SID,IDSTAT,TFIEN) ;Update sourceid multiple
+1 NEW FDA,DGENDA,FILE,IENS
+2 SET FILE=391.9101
+3 ;Update existing sub record
IF $DATA(^DGCN(391.91,TFIEN,1,"B",SID))
Begin DoDot:1
+4 SET DGENDA=$ORDER(^DGCN(391.91,TFIEN,1,"B",SID,0))
+5 SET DGENDA(1)=TFIEN
SET IENS=$$IENS^DILF(.DGENDA)
+6 SET FDA(FILE,IENS,.01)=SID
SET FDA(FILE,IENS,1)=IDSTAT
+7 DO FILE^DIE("K","FDA","ERRORS(1)")
End DoDot:1
QUIT
+8 ;add new sub record
+9 SET DGENDA="+1"
SET DGENDA(1)=TFIEN
SET IENS=$$IENS^DILF(.DGENDA)
+10 SET FDA(FILE,IENS,.01)=SID
SET FDA(FILE,IENS,1)=IDSTAT
+11 DO UPDATE^DIE("","FDA","IENA","ERRORS(1)")
+12 QUIT
SETSND(PDFN) ;sets the pivot file entry to send MFU
+1 ;
+2 NEW ANS,X
+3 SET X="MPIF001"
XECUTE ^%ZOSF("TEST")
if '$TEST
QUIT
+4 ; check if other facilities other than CMOR in TF list
+5 NEW SIT,CMOR,STOP
+6 SET CMOR=$$GETVCCI^MPIF001(PDFN)
+7 ; **520 REMOVED +
SET CMOR=$$LKUP^XUAF4(CMOR)
+8 IF CMOR=$PIECE($$SITE^VASITE,"^")
Begin DoDot:1
+9 SET SIT=0
+10 SET SIT=$ORDER(^DGCN(391.91,"APAT",PDFN,SIT))
+11 IF SIT=CMOR
SET SIT=$ORDER(^DGCN(391.91,"APAT",PDFN,SIT))
IF SIT=""
SET STOP=""
End DoDot:1
+12 IF $DATA(STOP)
QUIT
+13 SET ANS=$$PIVNW^VAFHPIVT(PDFN,DT,5,PDFN_";DPT(")
+14 IF 'ANS
QUIT
+15 DO XMITFLAG^VAFCDD01(0,+ANS,0)
SETSNDQ QUIT
+1 ;
FILEDIT(TFIEN,PDLT,PDFN,FAC,EVNTR,VAFCSLT,ERROR,IPP,SOURCEID,IDENSTAT,AA,IDTYP) ;
+1 NEW DGSENFLG,FDA,FDAIEN,ERR,RESULT
SET DGSENFLG=""
SET ERR=""
+2 IF $GET(PDLT)'=""!($GET(IPP)'="")!($GET(AA)'="")!($GET(IDTYP)'="")!($GET(SOURCEID)'="")!($GET(IDENSTAT)'="")
Begin DoDot:1
+3 SET TFIEN(0)=$GET(^DGCN(391.91,TFIEN,0))
+4 IF $GET(EVNTR)'=""
DO CHK^DIE(391.91,.07,"",EVNTR,.RESULT)
IF +RESULT>0
SET EVNTR=RESULT
+5 IF $GET(PDLT)'=""
SET FDA(1,391.91,+TFIEN_",",.03)=$GET(PDLT)
+6 SET FDA(1,391.91,+TFIEN_",",.07)=$GET(EVNTR)
+7 IF $GET(IPP)'=""
SET FDA(1,391.91,+TFIEN_",",.08)=$GET(IPP)
+8 ;**837 - MVI_791 (ckn)
+9 IF $GET(AA)'=""
SET FDA(1,391.91,+TFIEN_",",10)=$GET(AA)
+10 IF $GET(IDTYP)'=""
SET FDA(1,391.91,+TFIEN_",",.09)=$GET(IDTYP)
+11 IF $GET(SOURCEID)'=""
SET FDA(1,391.91,+TFIEN_",",11)=$GET(SOURCEID)
+12 IF $GET(IDENSTAT)'=""
SET FDA(1,391.91,+TFIEN_",",12)=$GET(IDENSTAT)
+13 DO FILE^DIE("K","FDA(1)","ERR")
IF VAFCSLT
IF $DATA(ERR("DIERR",1))
SET ERROR(STA)="Edit of "_STA_" Failed at "_$PIECE($$SITE^VASITE,"^",3)_" due to "_$GET(ERR("DIERR",1,"TEXT",1))
End DoDot:1
+14 ;**837 - MVI_791 (ckn) - no more updates to multiples
+15 ;I $G(SOURCEID)'="" D UPDSID(PDFN,FAC,SOURCEID,IDENSTAT,TFIEN)
+16 ;remove code to add a subscription
+17 QUIT
+18 ;
DELETETF(PAT,INST,DTIEN) ;deletion entry point
+1 ;This entry point is used to delete a single Treating Facility from
+2 ;the Treating Facility list.
+3 ;**837 - MVI_791 (ckn) - Now we will have multiple entries in TF file so it is determined which entry to be deleted before calling this api. Hence, Treating Facility IEN is passed in. Unused code is commented out.
+4 ;INPUT PAT - the ICN of the patient.
+5 ; INST - the IEN of the institution to be deleted.
+6 ; DTIEN - the IEN of Treating Facility file
+7 ;OUTPUT 0 (zero) - If no errors
+8 ; 1^error description if there was a problem
+9 ;
+10 ;**837 v4 MVI 791 (ckn) - check if DTIEN is passed
+11 IF $GET(DTIEN)=""
QUIT "-1^DTIEN - IEN of Treating Facility not defined"
+12 NEW VAFCER,PDFN,TFIEN,X,VAFCSCN,LINK,VAFCLLN,IEN
+13 SET VAFCER=0
+14 IF '$GET(PAT)!('$GET(INST))
SET VAFCER="1^Parameter missing."
SET ERROR(INST)="212"_"^"_$GET(HL("MID"))_"^"_"Delete Failed: "_$PIECE(VAFCER,"^")
GOTO DELTFQ
+15 SET X="MPIF001"
XECUTE ^%ZOSF("TEST")
IF '$TEST
GOTO FILETFQ
+16 SET PDFN=$$GETDFN^MPIF001(+PAT)
+17 IF PDFN<0
SET VAFCER="1^No patient DFN."
GOTO FILETFQ
+18 IF '$$FIND1^DIC(4,"","MX","`"_INST)
SET VAFCER="1^Not an Institution IEN."
GOTO DELTFQ
+19 IF '$DATA(^DGCN(391.91,DTIEN))
SET VAFCER="1^Could not find Treating Facility."
GOTO DELTFQ
+20 DO DELETE(DTIEN)
+21 IF $DATA(^DGCN(391.91,DTIEN))
SET VAFCER="1^DIK failed to delete entry"
GOTO DELTFQ
+22 ;terminate the subscription if there is one
+23 SET VAFCSCN=+$PIECE($$MPINODE^MPIFAPI(PDFN),"^",5)
IF +$GET(VAFCSCN)>0
Begin DoDot:1
+24 ;get logical link
+25 DO LINK^HLUTIL3(INST,.LINK)
SET VAFCLLN=$ORDER(LINK(0))
IF +$GET(VAFCLLN)>0
SET VAFCLLN=LINK(VAFCLLN)
DO UPD^HLSUB(VAFCSCN,VAFCLLN,0,,$$NOW^XLFDT,,.HLER)
End DoDot:1
+26 ;**837 - MVI_791 (ckn) - no need to retire pdr anymore as it is not used
+27 ;D RETPDR^VAFCEHU2(PDFN,INST) ;**474 retire pdr when deleting tf
DELTFQ QUIT VAFCER
+1 ;
DELETE(TFIEN) ;the actual deletion code
+1 ;
+2 KILL DIK,DA
+3 SET DIK="^DGCN(391.91,"
+4 SET DA=TFIEN
+5 DO ^DIK
KILL DIK,DA
+6 QUIT
+7 ;
DELALLTF(PAT) ;Entry point to delete all Treating Facilities for a single patient.
+1 ;INPUT PAT - The patient's ICN
+2 ;OUTPUT 0 (zero) - If no errors
+3 ; 1^error description if an error
+4 ;
+5 NEW VAFCER,PDFN,LP,TFIEN,X
+6 SET VAFCER=0
+7 IF '$GET(PAT)
QUIT "1^Parameter missing."
+8 SET X="MPIF001"
XECUTE ^%ZOSF("TEST")
IF '$TEST
QUIT 0
+9 SET PDFN=$$GETDFN^MPIF001(PAT)
+10 IF PDFN<0
QUIT "1^No patient DFN."
+11 FOR LP=0:0
SET LP=$ORDER(^DGCN(391.91,"APAT",PDFN,LP))
if LP'>0
QUIT
Begin DoDot:1
+12 SET TFIEN=0
FOR
SET TFIEN=$ORDER(^DGCN(391.91,"APAT",PDFN,LP,TFIEN))
if TFIEN'>0
QUIT
DO DELETE(TFIEN)
End DoDot:1
+13 ;
+14 QUIT VAFCER
+15 ;
