AGMPHMFN ; IHS/SD/TPF - HLO MPI MFN-M05 PROCESSING RTN ;
;;7.2;IHS PATIENT REGISTRATION;**1,3,7**;MAY 20, 2010;Build 26
;
Q
;
PROC(HLMSGIEN,SUCCESS) ;EP - PROCESS MFN-M05 TREATING FACILITY UPDATE MESSAGE FROM MPI
N DATA,HLMSTATE,MSGID,MSGSEG,ICNEUID,ERROR,MFK,MFNERR,GARBLED,AGERROR
; 05/28/2013 - KJH - TFS8069 - 'SUCCESS' must have a default value (of NULL - meaning failed) in case of an early QUIT due to an error.
S SUCCESS=""
D PARSE(.DATA,HLMSGIEN,.HLMSTATE)
M MFK=DATA
D NOW^%DTC S NOW=%
S NOW=$TR($$FMTE^XLFDT($P(NOW,"@"),"5DZ"),"/")
S NOW=$E(NOW,5,8)_$E(NOW,1,2)_$E(NOW,3,4)
N NXT,ICNEUID,ACKIEN,LOCALID,SETICN,SEGIEN,SEGMENT,OSTANUMB,OSTANAME
S SEGMENT=DATA(1,1,1,1,1)
Q:SEGMENT'="MFI" ;MFN W/O MFI AS FIRST SEGMENT - THROW ERROR
I SEGMENT="MFA" D
.S ERROR="MFA IN MFN?" D MSGERR(0,HLMSGIEN,HLMSGIEN,ERROR)
S TYPEUPD=$G(DATA(1,4,1,1,1)) ;TYPE OF UPDATE UPD=UPDATE OR REP=REPLACE
IF TYPEUPD="" D
.S ERROR="TYPEUPD PULLED FROM DATA(1,4,1,1,1) WAS EMPTY." D MSGERR(0,HLMSGIEN,HLMSGIEN,ERROR)
;
;IF 'REP' THEN ALL MFEs SHOULD BE 'MAD'
;PER PROTOCOL ALL SHOULD BE REP. WE DELETE THE ENTRIES AND REPLACE
;WITH WHAT THE MPI SENDS TO UPDATE
;FIND LOCAL ID BASED ON STATION NUMBER IN MESSAGE
S LOCALID=$$GETLOCAL(.DATA,DATA("HDR","RECEIVING FACILITY",1))
; 05/28/2013 - KJH - TFS8069 - Report error if LOCALID is not returned due to the UNDEF fix below.
I LOCALID="" D Q
.S ERROR="MISSING LOCALID" D MSGERR(0,HLMSGIEN,HLMSGIEN,ERROR)
I TYPEUPD="REP" D DELPTREC(LOCALID) ;DELETE ALL PT RECORDS FOR LOCAL ID
;PROCESS SEGIEN BEGINNING AT FIRST MFE SEGMENT
S GARBLED=0
S SEGIEN=1
F S SEGIEN=$O(DATA(SEGIEN)) Q:'SEGIEN D
.S SEGMENT=DATA(SEGIEN,1,1,1,1)
.Q:SEGMENT="ZET" ;DON'T PROCESS THESE YET
.I SEGMENT'="MFE" D Q ;SEND ONLY ONE ALERT
..K MFK(SEGIEN),DATA(SEGIEN)
..Q:GARBLED
..S ERROR="POSSIBLE GARBLED MESSAGE"
..D MSGERR("",HLMSGIEN,HLMSGIEN,ERROR)
..S GARBLED=1
.D GETVARS(SEGIEN)
.;1/15/2018 - GCD - CR 10010 - Update ICN for add ("MAD") or update ("MUP"); delete ICN for delete ("MDL").
.I DATA("HDR","RECEIVING FACILITY",1)=STATNUM,REMOTEID'="" D
..I UPDTYPE="MAD"!(UPDTYPE="MUP") S ICNEUID=$G(DATA(SEGIEN,5,1,4,1)) I ICNEUID'="" D UPDEUID(REMOTEID,ICNEUID) Q
..I UPDTYPE="MDL" D DELEUID(REMOTEID) Q
.I UPDTYPE="MUP" D UPD Q
.I UPDTYPE="MDL" D DEL Q
.I UPDTYPE="MAD" D ADD Q
D CREATMSG^AGMPIHLO(LOCALID,"M05",,.SUCCESS) ;SENDMFK BACK
I SUCCESS D MSGCMPLT^AGMPIBGP(HLMSGIEN) I 1 ;I 1 USED TO RESTORE THE VALUE OF $T AFTER THE CALL
E S ERROR="CAN'T CREATE MFK" D
.D MSGERR(LOCALID,HLMSGIEN,HLMSGIEN,ERROR)
Q
;
GETLOCAL(DATA,LSTATNUM) ;EP - GET LOCAL
N STATNUM,SEGIEN,SEGMENT,LOCALID,EUID
; 05/28/2013 - KJH - TFS8069 - Fix UNDEF error on the LOCALID and EUID variables. See also checks on the call to UPDEUID below.
S SEGIEN=1,LOCALID="",EUID=""
F S SEGIEN=$O(DATA(SEGIEN)) Q:'SEGIEN D
.S SEGMENT=DATA(SEGIEN,1,1,1,1)
.Q:SEGMENT="ZET"
.S STATNUM=$G(DATA(SEGIEN,5,1,2,1))
.I LSTATNUM=STATNUM D Q
..S LOCALID=$G(DATA(SEGIEN,5,1,1,1))
..S EUID=$G(DATA(SEGIEN,5,1,4,1))
; 1/15/2018 - GCD - CR 10010 - Commented out so we can do this correctly above.
;I LOCALID]"",EUID]"" D UPDEUID(LOCALID,EUID)
Q LOCALID
;
UPDEUID(LOCALID,EUID) ;UPDATE ICN IF DIFFERENT FROM THIS ONE
N CURICN,NOW
S CURICN=$$GET1^DIQ(2,LOCALID_",",991.01)
;1/15/2018 - GCD - CR 10010 - Allow updating the ICN when there isn't one already assigned.
;Q:CURICN=EUID!(CURICN="")
Q:CURICN=EUID
D ADDICN^AGMPHLVQ(EUID,LOCALID) ;REPLACE OLD WITH NEW "UNLINK" AT MPI
K DIR,DIE,DIC,DR,DA
S DA(1)=LOCALID
S DIC="^DPT("_DA(1)_",""MPIFHIS"","
S DIC(0)="L"
S X=CURICN
D ^DIC
I Y<0 D Q
.D MSGERR(LOCALID,HLMSGIEN,HLMSGIEN,"ICN HIST "_CURICN)
S DA=+Y
K DIR,DIE,DIC,DR
D NOW^%DTC S AGNOW=%
;B "S+"
;S DIE="^DPT("_DA(1)_",""MPIFHIS"","_DA_","
;S DR="3///^S X=AGNOW"
;D ^DIE
S $P(^DPT(DA(1),"MPIFHIS",DA,0),U,4)=AGNOW
K DIR,DIE,DIC,DR,DA
Q
;
;1/15/2018 - GCD - CR 10010 - Delete the ICN when an "MDL" message is received.
DELEUID(LOCALID) ;DELETE ICN FROM PATIENT RECORD
I $P($G(^DPT($G(LOCALID," "),"MPI")),U)="" Q
N DIE,DA,DR
S DIE="^DPT(",DA=LOCALID
S DR="991.01///@"
D ^DIE
Q
;
ADD ;EP - ADD ENTRY TO TREATING FACILITY LIST
K FDA,FDAIEN,DD,DO,DIC,DA,RESULT,UPDERR
S FDA(1,391.91,"+1,",.01)=LOCALID
S FDA(1,391.91,"+1,",.02)=INST
S FDA(1,391.91,"+1,",.03)=DTLASTTR
S FDA(1,391.91,"+1,",9999999.01)=REMOTEID
S FDA(1,391.91,"+1,",9999999.02)=EUID
;S FDA(1,391.91,"+1,",.07)=EVENT
D UPDATE^DIE("","FDA(1)","FDAIEN","UPDERR")
I $D(UPDERR("DIERR",1)) D
.S MFNERR(SEGIEN)="Add of TFL"_INST_" failed for "_LOCALID_" due to "_$G(UPDERR("DIERR",1,"TEXT",1))
.S ERROR=MFNERR(SEGIEN) D MSGERR(LOCALID,HLMSGIEN,HLMSGIEN,ERROR)
S MFK(SEGIEN+.5)="MFA"_DATA("HDR","FIELD SEPARATOR")_UPDTYPE_DATA("HDR","FIELD SEPARATOR")_STATNUM_DATA("HDR","FIELD SEPARATOR")_NOW_DATA("HDR","FIELD SEPARATOR")_$S($D(MFNERR(SEGIEN)):"U",1:"S")
Q
UPD ;EP - UPDATE BASED ON INSTITUTION LOOKUP
K DIE,DIC,DR,DA,DIR
;05/30/2013 - KJH - TFS8079 - Updated next line to use 'LOCALID'. Was originally using 'REMOTE' which does not exist. 'REMOTEID' is also wrong.
S DA=$O(^DGCN(391.91,"AINST",INST,LOCALID,""))
I 'DA D ADD Q
S DIE="^DGCN(391.91,"
S DR=".03///"_DTLASTTR
D ^DIE
I $$GET1^DIQ(391.91,DA_",",.03)="" D
.S MFNERR(SEGIEN)="UPD UPDATE DID NOT UPDATE 'LAST TREATED DATE' FOR "_LOCALID_" AND "_INST_" INSTITUTION."
.;05/29/2013 - KJH - TFS8079 - Added call to MSGERR.
.S ERROR=MFNERR(SEGIEN) D MSGERR(LOCALID,HLMSGIEN,HLMSGIEN,ERROR)
S MFK(SEGIEN+.5)="MFA"_DATA("HDR","FIELD SEPARATOR")_UPDTYPE_DATA("HDR","FIELD SEPARATOR")_STATNUM_DATA("HDR","FIELD SEPARATOR")_NOW_DATA("HDR","FIELD SEPARATOR")_$S($D(MFNERR(SEGIEN)):"U",1:"S")
Q
;
DEL ;EP - DELETE ENTRY
K DIE,DIC,DR,DA,DIR
;05/30/2013 - KJH - TFS8079 - Updated next line to use 'LOCALID'. Was originally using 'REMOTEID' which is wrong.
S DA=$O(^DGCN(391.91,"AINST",INST,LOCALID,""))
I 'DA D Q ;THROW ERROR AND SEND BACK IN AL ACK
.;05/29/2013 - KJH - TFS8079 - Update error message text and added call to MSGERR.
.S MFNERR(SEGIEN)="DEL DID NOT FIND TFL RECORD FOR "_LOCALID_" AND "_INST_" INSTITUTION."
.S ERROR=MFNERR(SEGIEN) D MSGERR(LOCALID,HLMSGIEN,HLMSGIEN,ERROR)
.S MFK(SEGIEN+.5)="MFA"_DATA("HDR","FIELD SEPARATOR")_UPDTYPE_DATA("HDR","FIELD SEPARATOR")_STATNUM_DATA("HDR","FIELD SEPARATOR")_NOW_DATA("HDR","FIELD SEPARATOR")_$S($D(MFNERR(SEGIEN)):"U",1:"S")
; 05/29/2013 - KJH - TFS8079 - Moved next 3 lines outside the dotted DO since they need to be run when DA exists.
S DIK="^DGCN(391.91,"
D ^DIK
S MFK(SEGIEN+.5)="MFA"_DATA("HDR","FIELD SEPARATOR")_UPDTYPE_DATA("HDR","FIELD SEPARATOR")_STATNUM_DATA("HDR","FIELD SEPARATOR")_NOW_DATA("HDR","FIELD SEPARATOR")_$S($D(MFNERR(SEGIEN)):"U",1:"S")
Q
;
GETVARS(SEGIEN) ;EP - SET VARIABLES
N MFNCTLID
S UPDTYPE=$G(DATA(SEGIEN,2,1,1,1)) ;MAD=ADD RECORD;MDL=DELETE RECORD;MUP=UPDATE RECORD
I UPDTYPE="" D ;THROW ERROR AND SEND BACK IN MFK
.S MFNERR(SEGIEN)="MISSING TYPE OF EVENT"
.D MSGERR(LOCALID,HLMSGIEN,HLMSGIEN,MFNERR(SEGIEN))
;05/29/2013 - KJH - TFS8079 - Make 'MFN CONTROL ID' variable name, comment, and error message consistent.
S MFNCTLID=$G(DATA(SEGIEN,3,1,1,1)) ;MFN CONTROL ID
I 'MFNCTLID D ;THROW ERROR AND SEND BACK IN MFK
.S MFNERR(SEGIEN)="MISSING MFN CONTROL ID"
.D MSGERR(LOCALID,HLMSGIEN,HLMSGIEN,MFNERR(SEGIEN))
S DTLASTTR=$P($G(DATA(SEGIEN,4,1,1,1))," ") ;DATE LAST TREATED
S DTLASTTR=$P(DTLASTTR,"-",2)_"-"_$P(DTLASTTR,"-",3)_"-"_$P(DTLASTTR,"-")
S TIMELST=$TR($P($G(DATA(SEGIEN,4,1,1,1))," ",2),":") ;TIME LAST TREATED
;2010-07-10 00:00:00 E.G.
K %DT S X=DTLASTTR D ^%DT S DTLASTTR=Y
S DTLASTTR=DTLASTTR_"."_TIMELST
S EUID=$G(DATA(SEGIEN,5,1,4,1)) ;EUID/ICN
I EUID="" D ;THROW ERROR AND SEND BACK IN MFK
.S MFNERR(SEGIEN)="MISSING EUID"
.D MSGERR(LOCALID,HLMSGIEN,HLMSGIEN,MFNERR(SEGIEN))
S STATNUM=$G(DATA(SEGIEN,5,1,2,1))
I 'STATNUM D
.S MFNERR(SEGIEN)="NO STATION NUMBER"
.D MSGERR(LOCALID,HLMSGIEN,HLMSGIEN,MFNERR(SEGIEN))
S:STATNUM INST=$O(^DIC(4,"D",STATNUM,"")) ;INSTITUTION PTR
I $G(INST)="" D ;THROW ERROR AND SEND BACK IN AL ACK
.S MFNERR(SEGIEN)="CAN'T FIND INSTITUTION FOR GIVEN STATION NUMBER MSG:"_STATNUM
.D MSGERR(LOCALID,HLMSGIEN,HLMSGIEN,MFNERR(SEGIEN))
;05/30/2013 - KJH - TFS8069 - Change message to use 'REMOTE ID' since we have another message using 'LOCALID' already.
S REMOTEID=$G(DATA(SEGIEN,5,1,1,1))
I 'REMOTEID D ;THROW AN ERROR AND SEND BACK IN AL ACK
.S MFNERR(SEGIEN)="NO REMOTE ID"
.D MSGERR(LOCALID,HLMSGIEN,HLMSGIEN,MFNERR(SEGIEN))
I $D(MFNERR(SEGIEN)) D
.S MFK(SEGIEN+.5)="MFA"_DATA("HDR","FIELD SEPARATOR")_UPDTYPE_DATA("HDR","FIELD SEPARATOR")_STATNUM_DATA("HDR","FIELD SEPARATOR")_NOW_DATA("HDR","FIELD SEPARATOR")_$S($D(MFNERR(SEGIEN)):"U",1:"S")
;05/29/2013 - KJH - TFS8079 - Following lines are not needed as MSGERR is called above for each error.
;I $D(MFNERR) D
;.S ERROR=$G(MFNERR(SEGIEN))
;.I ERROR="" S ERROR="UNKNOWN ERROR IN MFN MESSAGE FROM MPI"
;.D MSGERR(LOCALID,HLMSGIEN,HLMSGIEN,ERROR)
Q
;
DELPTREC(LOCALID) ;EP - DELETE RECORDS FOR LOCAL ID
N DIK,IEN,DA
;^DGCN(391.91,"B",5571,1)=
;^DGCN(391.91,"B",5571,2)=
S DIK="^DGCN(391.91,"
S DA=0
F S DA=$O(^DGCN(391.91,"B",LOCALID,DA)) Q:'DA D
.D ^DIK
Q
;
PARSE(DATA,MIEN,HLMSTATE) ;EP
N SEG,CNT
Q:'$$STARTMSG^HLOPRS(.HLMSTATE,MIEN)
M DATA("HDR")=HLMSTATE("HDR")
S CNT=0
F Q:'$$NEXTSEG^HLOPRS(.HLMSTATE,.SEG) D
.S CNT=CNT+1
.M DATA(CNT)=SEG
Q
;
MSGERR(LOCALID,MSGIEN,HLMSGIEN,ERROR) ;EP - ERROR OCURRED IN A28 ACK
S AGERROR="MPI MSG MFN:"_HLMSGIEN_": "_ERROR
D NOTIF^AGMPIHLO(LOCALID,AGERROR)
Q
AGMPHMFN ; IHS/SD/TPF - HLO MPI MFN-M05 PROCESSING RTN ;
+1 ;;7.2;IHS PATIENT REGISTRATION;**1,3,7**;MAY 20, 2010;Build 26
+2 ;
+3 QUIT
+4 ;
PROC(HLMSGIEN,SUCCESS) ;EP - PROCESS MFN-M05 TREATING FACILITY UPDATE MESSAGE FROM MPI
+1 NEW DATA,HLMSTATE,MSGID,MSGSEG,ICNEUID,ERROR,MFK,MFNERR,GARBLED,AGERROR
+2 ; 05/28/2013 - KJH - TFS8069 - 'SUCCESS' must have a default value (of NULL - meaning failed) in case of an early QUIT due to an error.
+3 SET SUCCESS=""
+4 DO PARSE(.DATA,HLMSGIEN,.HLMSTATE)
+5 MERGE MFK=DATA
+6 DO NOW^%DTC
SET NOW=%
+7 SET NOW=$TRANSLATE($$FMTE^XLFDT($PIECE(NOW,"@"),"5DZ"),"/")
+8 SET NOW=$EXTRACT(NOW,5,8)_$EXTRACT(NOW,1,2)_$EXTRACT(NOW,3,4)
+9 NEW NXT,ICNEUID,ACKIEN,LOCALID,SETICN,SEGIEN,SEGMENT,OSTANUMB,OSTANAME
+10 SET SEGMENT=DATA(1,1,1,1,1)
+11 ;MFN W/O MFI AS FIRST SEGMENT - THROW ERROR
IF SEGMENT'="MFI"
QUIT
+12 IF SEGMENT="MFA"
Begin DoDot:1
+13 SET ERROR="MFA IN MFN?"
DO MSGERR(0,HLMSGIEN,HLMSGIEN,ERROR)
End DoDot:1
+14 ;TYPE OF UPDATE UPD=UPDATE OR REP=REPLACE
SET TYPEUPD=$GET(DATA(1,4,1,1,1))
+15 IF TYPEUPD=""
Begin DoDot:1
+16 SET ERROR="TYPEUPD PULLED FROM DATA(1,4,1,1,1) WAS EMPTY."
DO MSGERR(0,HLMSGIEN,HLMSGIEN,ERROR)
End DoDot:1
+17 ;
+18 ;IF 'REP' THEN ALL MFEs SHOULD BE 'MAD'
+19 ;PER PROTOCOL ALL SHOULD BE REP. WE DELETE THE ENTRIES AND REPLACE
+20 ;WITH WHAT THE MPI SENDS TO UPDATE
+21 ;FIND LOCAL ID BASED ON STATION NUMBER IN MESSAGE
+22 SET LOCALID=$$GETLOCAL(.DATA,DATA("HDR","RECEIVING FACILITY",1))
+23 ; 05/28/2013 - KJH - TFS8069 - Report error if LOCALID is not returned due to the UNDEF fix below.
+24 IF LOCALID=""
Begin DoDot:1
+25 SET ERROR="MISSING LOCALID"
DO MSGERR(0,HLMSGIEN,HLMSGIEN,ERROR)
End DoDot:1
QUIT
+26 ;DELETE ALL PT RECORDS FOR LOCAL ID
IF TYPEUPD="REP"
DO DELPTREC(LOCALID)
+27 ;PROCESS SEGIEN BEGINNING AT FIRST MFE SEGMENT
+28 SET GARBLED=0
+29 SET SEGIEN=1
+30 FOR
SET SEGIEN=$ORDER(DATA(SEGIEN))
IF 'SEGIEN
QUIT
Begin DoDot:1
+31 SET SEGMENT=DATA(SEGIEN,1,1,1,1)
+32 ;DON'T PROCESS THESE YET
IF SEGMENT="ZET"
QUIT
+33 ;SEND ONLY ONE ALERT
IF SEGMENT'="MFE"
Begin DoDot:2
+34 KILL MFK(SEGIEN),DATA(SEGIEN)
+35 IF GARBLED
QUIT
+36 SET ERROR="POSSIBLE GARBLED MESSAGE"
+37 DO MSGERR("",HLMSGIEN,HLMSGIEN,ERROR)
+38 SET GARBLED=1
End DoDot:2
QUIT
+39 DO GETVARS(SEGIEN)
+40 ;1/15/2018 - GCD - CR 10010 - Update ICN for add ("MAD") or update ("MUP"); delete ICN for delete ("MDL").
+41 IF DATA("HDR","RECEIVING FACILITY",1)=STATNUM
IF REMOTEID'=""
Begin DoDot:2
+42 IF UPDTYPE="MAD"!(UPDTYPE="MUP")
SET ICNEUID=$GET(DATA(SEGIEN,5,1,4,1))
IF ICNEUID'=""
DO UPDEUID(REMOTEID,ICNEUID)
QUIT
+43 IF UPDTYPE="MDL"
DO DELEUID(REMOTEID)
QUIT
End DoDot:2
+44 IF UPDTYPE="MUP"
DO UPD
QUIT
+45 IF UPDTYPE="MDL"
DO DEL
QUIT
+46 IF UPDTYPE="MAD"
DO ADD
QUIT
End DoDot:1
+47 ;SENDMFK BACK
DO CREATMSG^AGMPIHLO(LOCALID,"M05",,.SUCCESS)
+48 ;I 1 USED TO RESTORE THE VALUE OF $T AFTER THE CALL
IF SUCCESS
DO MSGCMPLT^AGMPIBGP(HLMSGIEN)
IF 1
+49 IF '$TEST
SET ERROR="CAN'T CREATE MFK"
Begin DoDot:1
+50 DO MSGERR(LOCALID,HLMSGIEN,HLMSGIEN,ERROR)
End DoDot:1
+51 QUIT
+52 ;
GETLOCAL(DATA,LSTATNUM) ;EP - GET LOCAL
+1 NEW STATNUM,SEGIEN,SEGMENT,LOCALID,EUID
+2 ; 05/28/2013 - KJH - TFS8069 - Fix UNDEF error on the LOCALID and EUID variables. See also checks on the call to UPDEUID below.
+3 SET SEGIEN=1
SET LOCALID=""
SET EUID=""
+4 FOR
SET SEGIEN=$ORDER(DATA(SEGIEN))
IF 'SEGIEN
QUIT
Begin DoDot:1
+5 SET SEGMENT=DATA(SEGIEN,1,1,1,1)
+6 IF SEGMENT="ZET"
QUIT
+7 SET STATNUM=$GET(DATA(SEGIEN,5,1,2,1))
+8 IF LSTATNUM=STATNUM
Begin DoDot:2
+9 SET LOCALID=$GET(DATA(SEGIEN,5,1,1,1))
+10 SET EUID=$GET(DATA(SEGIEN,5,1,4,1))
End DoDot:2
QUIT
End DoDot:1
+11 ; 1/15/2018 - GCD - CR 10010 - Commented out so we can do this correctly above.
+12 ;I LOCALID]"",EUID]"" D UPDEUID(LOCALID,EUID)
+13 QUIT LOCALID
+14 ;
UPDEUID(LOCALID,EUID) ;UPDATE ICN IF DIFFERENT FROM THIS ONE
+1 NEW CURICN,NOW
+2 SET CURICN=$$GET1^DIQ(2,LOCALID_",",991.01)
+3 ;1/15/2018 - GCD - CR 10010 - Allow updating the ICN when there isn't one already assigned.
+4 ;Q:CURICN=EUID!(CURICN="")
+5 IF CURICN=EUID
QUIT
+6 ;REPLACE OLD WITH NEW "UNLINK" AT MPI
DO ADDICN^AGMPHLVQ(EUID,LOCALID)
+7 KILL DIR,DIE,DIC,DR,DA
+8 SET DA(1)=LOCALID
+9 SET DIC="^DPT("_DA(1)_",""MPIFHIS"","
+10 SET DIC(0)="L"
+11 SET X=CURICN
+12 DO ^DIC
+13 IF Y<0
Begin DoDot:1
+14 DO MSGERR(LOCALID,HLMSGIEN,HLMSGIEN,"ICN HIST "_CURICN)
End DoDot:1
QUIT
+15 SET DA=+Y
+16 KILL DIR,DIE,DIC,DR
+17 DO NOW^%DTC
SET AGNOW=%
+18 ;B "S+"
+19 ;S DIE="^DPT("_DA(1)_",""MPIFHIS"","_DA_","
+20 ;S DR="3///^S X=AGNOW"
+21 ;D ^DIE
+22 SET $PIECE(^DPT(DA(1),"MPIFHIS",DA,0),U,4)=AGNOW
+23 KILL DIR,DIE,DIC,DR,DA
+24 QUIT
+25 ;
+26 ;1/15/2018 - GCD - CR 10010 - Delete the ICN when an "MDL" message is received.
DELEUID(LOCALID) ;DELETE ICN FROM PATIENT RECORD
+1 IF $PIECE($GET(^DPT($GET(LOCALID," "),"MPI")),U)=""
QUIT
+2 NEW DIE,DA,DR
+3 SET DIE="^DPT("
SET DA=LOCALID
+4 SET DR="991.01///@"
+5 DO ^DIE
+6 QUIT
+7 ;
ADD ;EP - ADD ENTRY TO TREATING FACILITY LIST
+1 KILL FDA,FDAIEN,DD,DO,DIC,DA,RESULT,UPDERR
+2 SET FDA(1,391.91,"+1,",.01)=LOCALID
+3 SET FDA(1,391.91,"+1,",.02)=INST
+4 SET FDA(1,391.91,"+1,",.03)=DTLASTTR
+5 SET FDA(1,391.91,"+1,",9999999.01)=REMOTEID
+6 SET FDA(1,391.91,"+1,",9999999.02)=EUID
+7 ;S FDA(1,391.91,"+1,",.07)=EVENT
+8 DO UPDATE^DIE("","FDA(1)","FDAIEN","UPDERR")
+9 IF $DATA(UPDERR("DIERR",1))
Begin DoDot:1
+10 SET MFNERR(SEGIEN)="Add of TFL"_INST_" failed for "_LOCALID_" due to "_$GET(UPDERR("DIERR",1,"TEXT",1))
+11 SET ERROR=MFNERR(SEGIEN)
DO MSGERR(LOCALID,HLMSGIEN,HLMSGIEN,ERROR)
End DoDot:1
+12 SET MFK(SEGIEN+.5)="MFA"_DATA("HDR","FIELD SEPARATOR")_UPDTYPE_DATA("HDR","FIELD SEPARATOR")_STATNUM_DATA("HDR","FIELD SEPARATOR")_NOW_DATA("HDR","FIELD SEPARATOR")_$SELECT($DATA(MFNERR(SEGIEN)):"U",1:"S")
+13 QUIT
UPD ;EP - UPDATE BASED ON INSTITUTION LOOKUP
+1 KILL DIE,DIC,DR,DA,DIR
+2 ;05/30/2013 - KJH - TFS8079 - Updated next line to use 'LOCALID'. Was originally using 'REMOTE' which does not exist. 'REMOTEID' is also wrong.
+3 SET DA=$ORDER(^DGCN(391.91,"AINST",INST,LOCALID,""))
+4 IF 'DA
DO ADD
QUIT
+5 SET DIE="^DGCN(391.91,"
+6 SET DR=".03///"_DTLASTTR
+7 DO ^DIE
+8 IF $$GET1^DIQ(391.91,DA_",",.03)=""
Begin DoDot:1
+9 SET MFNERR(SEGIEN)="UPD UPDATE DID NOT UPDATE 'LAST TREATED DATE' FOR "_LOCALID_" AND "_INST_" INSTITUTION."
+10 ;05/29/2013 - KJH - TFS8079 - Added call to MSGERR.
+11 SET ERROR=MFNERR(SEGIEN)
DO MSGERR(LOCALID,HLMSGIEN,HLMSGIEN,ERROR)
End DoDot:1
+12 SET MFK(SEGIEN+.5)="MFA"_DATA("HDR","FIELD SEPARATOR")_UPDTYPE_DATA("HDR","FIELD SEPARATOR")_STATNUM_DATA("HDR","FIELD SEPARATOR")_NOW_DATA("HDR","FIELD SEPARATOR")_$SELECT($DATA(MFNERR(SEGIEN)):"U",1:"S")
+13 QUIT
+14 ;
DEL ;EP - DELETE ENTRY
+1 KILL DIE,DIC,DR,DA,DIR
+2 ;05/30/2013 - KJH - TFS8079 - Updated next line to use 'LOCALID'. Was originally using 'REMOTEID' which is wrong.
+3 SET DA=$ORDER(^DGCN(391.91,"AINST",INST,LOCALID,""))
+4 ;THROW ERROR AND SEND BACK IN AL ACK
IF 'DA
Begin DoDot:1
+5 ;05/29/2013 - KJH - TFS8079 - Update error message text and added call to MSGERR.
+6 SET MFNERR(SEGIEN)="DEL DID NOT FIND TFL RECORD FOR "_LOCALID_" AND "_INST_" INSTITUTION."
+7 SET ERROR=MFNERR(SEGIEN)
DO MSGERR(LOCALID,HLMSGIEN,HLMSGIEN,ERROR)
+8 SET MFK(SEGIEN+.5)="MFA"_DATA("HDR","FIELD SEPARATOR")_UPDTYPE_DATA("HDR","FIELD SEPARATOR")_STATNUM_DATA("HDR","FIELD SEPARATOR")_NOW_DATA("HDR","FIELD SEPARATOR")_$SELECT($DATA(MFNERR(SEGIEN)):"U",1:"S")
End DoDot:1
QUIT
+9 ; 05/29/2013 - KJH - TFS8079 - Moved next 3 lines outside the dotted DO since they need to be run when DA exists.
+10 SET DIK="^DGCN(391.91,"
+11 DO ^DIK
+12 SET MFK(SEGIEN+.5)="MFA"_DATA("HDR","FIELD SEPARATOR")_UPDTYPE_DATA("HDR","FIELD SEPARATOR")_STATNUM_DATA("HDR","FIELD SEPARATOR")_NOW_DATA("HDR","FIELD SEPARATOR")_$SELECT($DATA(MFNERR(SEGIEN)):"U",1:"S")
+13 QUIT
+14 ;
GETVARS(SEGIEN) ;EP - SET VARIABLES
+1 NEW MFNCTLID
+2 ;MAD=ADD RECORD;MDL=DELETE RECORD;MUP=UPDATE RECORD
SET UPDTYPE=$GET(DATA(SEGIEN,2,1,1,1))
+3 ;THROW ERROR AND SEND BACK IN MFK
IF UPDTYPE=""
Begin DoDot:1
+4 SET MFNERR(SEGIEN)="MISSING TYPE OF EVENT"
+5 DO MSGERR(LOCALID,HLMSGIEN,HLMSGIEN,MFNERR(SEGIEN))
End DoDot:1
+6 ;05/29/2013 - KJH - TFS8079 - Make 'MFN CONTROL ID' variable name, comment, and error message consistent.
+7 ;MFN CONTROL ID
SET MFNCTLID=$GET(DATA(SEGIEN,3,1,1,1))
+8 ;THROW ERROR AND SEND BACK IN MFK
IF 'MFNCTLID
Begin DoDot:1
+9 SET MFNERR(SEGIEN)="MISSING MFN CONTROL ID"
+10 DO MSGERR(LOCALID,HLMSGIEN,HLMSGIEN,MFNERR(SEGIEN))
End DoDot:1
+11 ;DATE LAST TREATED
SET DTLASTTR=$PIECE($GET(DATA(SEGIEN,4,1,1,1))," ")
+12 SET DTLASTTR=$PIECE(DTLASTTR,"-",2)_"-"_$PIECE(DTLASTTR,"-",3)_"-"_$PIECE(DTLASTTR,"-")
+13 ;TIME LAST TREATED
SET TIMELST=$TRANSLATE($PIECE($GET(DATA(SEGIEN,4,1,1,1))," ",2),":")
+14 ;2010-07-10 00:00:00 E.G.
+15 KILL %DT
SET X=DTLASTTR
DO ^%DT
SET DTLASTTR=Y
+16 SET DTLASTTR=DTLASTTR_"."_TIMELST
+17 ;EUID/ICN
SET EUID=$GET(DATA(SEGIEN,5,1,4,1))
+18 ;THROW ERROR AND SEND BACK IN MFK
IF EUID=""
Begin DoDot:1
+19 SET MFNERR(SEGIEN)="MISSING EUID"
+20 DO MSGERR(LOCALID,HLMSGIEN,HLMSGIEN,MFNERR(SEGIEN))
End DoDot:1
+21 SET STATNUM=$GET(DATA(SEGIEN,5,1,2,1))
+22 IF 'STATNUM
Begin DoDot:1
+23 SET MFNERR(SEGIEN)="NO STATION NUMBER"
+24 DO MSGERR(LOCALID,HLMSGIEN,HLMSGIEN,MFNERR(SEGIEN))
End DoDot:1
+25 ;INSTITUTION PTR
IF STATNUM
SET INST=$ORDER(^DIC(4,"D",STATNUM,""))
+26 ;THROW ERROR AND SEND BACK IN AL ACK
IF $GET(INST)=""
Begin DoDot:1
+27 SET MFNERR(SEGIEN)="CAN'T FIND INSTITUTION FOR GIVEN STATION NUMBER MSG:"_STATNUM
+28 DO MSGERR(LOCALID,HLMSGIEN,HLMSGIEN,MFNERR(SEGIEN))
End DoDot:1
+29 ;05/30/2013 - KJH - TFS8069 - Change message to use 'REMOTE ID' since we have another message using 'LOCALID' already.
+30 SET REMOTEID=$GET(DATA(SEGIEN,5,1,1,1))
+31 ;THROW AN ERROR AND SEND BACK IN AL ACK
IF 'REMOTEID
Begin DoDot:1
+32 SET MFNERR(SEGIEN)="NO REMOTE ID"
+33 DO MSGERR(LOCALID,HLMSGIEN,HLMSGIEN,MFNERR(SEGIEN))
End DoDot:1
+34 IF $DATA(MFNERR(SEGIEN))
Begin DoDot:1
+35 SET MFK(SEGIEN+.5)="MFA"_DATA("HDR","FIELD SEPARATOR")_UPDTYPE_DATA("HDR","FIELD SEPARATOR")_STATNUM_DATA("HDR","FIELD SEPARATOR")_NOW_DATA("HDR","FIELD SEPARATOR")_$SELECT($DATA(MFNERR(SEGIEN)):"U",1:"S")
End DoDot:1
+36 ;05/29/2013 - KJH - TFS8079 - Following lines are not needed as MSGERR is called above for each error.
+37 ;I $D(MFNERR) D
+38 ;.S ERROR=$G(MFNERR(SEGIEN))
+39 ;.I ERROR="" S ERROR="UNKNOWN ERROR IN MFN MESSAGE FROM MPI"
+40 ;.D MSGERR(LOCALID,HLMSGIEN,HLMSGIEN,ERROR)
+41 QUIT
+42 ;
DELPTREC(LOCALID) ;EP - DELETE RECORDS FOR LOCAL ID
+1 NEW DIK,IEN,DA
+2 ;^DGCN(391.91,"B",5571,1)=
+3 ;^DGCN(391.91,"B",5571,2)=
+4 SET DIK="^DGCN(391.91,"
+5 SET DA=0
+6 FOR
SET DA=$ORDER(^DGCN(391.91,"B",LOCALID,DA))
IF 'DA
QUIT
Begin DoDot:1
+7 DO ^DIK
End DoDot:1
+8 QUIT
+9 ;
PARSE(DATA,MIEN,HLMSTATE) ;EP
+1 NEW SEG,CNT
+2 IF '$$STARTMSG^HLOPRS(.HLMSTATE,MIEN)
QUIT
+3 MERGE DATA("HDR")=HLMSTATE("HDR")
+4 SET CNT=0
+5 FOR
IF '$$NEXTSEG^HLOPRS(.HLMSTATE,.SEG)
QUIT
Begin DoDot:1
+6 SET CNT=CNT+1
+7 MERGE DATA(CNT)=SEG
End DoDot:1
+8 QUIT
+9 ;
MSGERR(LOCALID,MSGIEN,HLMSGIEN,ERROR) ;EP - ERROR OCURRED IN A28 ACK
+1 SET AGERROR="MPI MSG MFN:"_HLMSGIEN_": "_ERROR
+2 DO NOTIF^AGMPIHLO(LOCALID,AGERROR)
+3 QUIT
