- 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