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

AGMPHMFN.m

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