- 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 Jan 18, 2025@04:03:10 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 ;