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

XUMFX.m

Go to the documentation of this file.
  1. XUMFX ;ISS/RAM - XUMF API's;04/15/02
  1. ;;8.0;KERNEL;**299,382,383**;Jul 10, 1995
  1. ;
  1. Q
  1. ;
  1. ;
  1. MFE(IFN,PKV,HLCS,IEN,ERROR) ; -- update
  1. ;
  1. N IENS,MFE,I,X,ID,XREF,NAME,FLD,FDA,DIC,Y
  1. ;
  1. S IFN=$G(IFN),IEN=$G(IEN),HLCS=$G(HLCS),ERROR=$G(ERROR)
  1. S:HLCS="" HLCS="~"
  1. ;
  1. Q:ERROR
  1. ;
  1. I 'IFN S ERROR="1^Error - IFN required HLNODE: "_HLNODE Q
  1. ;
  1. I $P(PKV,HLCS)=""!($P(PKV,HLCS,2)="")!($P(PKV,HLCS,4)="") D Q:ERROR
  1. .Q:$G(XUMFSDS)="1H"
  1. .S ERROR="1^Error - PKV not valid HLNODE: "_HLNODE
  1. .D EM^XUMFH(ERROR,.ERR)
  1. ;
  1. S MFE=$G(^DIC(4.001,IFN,"MFE")),XREF=$P(MFE,U,8)
  1. I XREF="" D Q
  1. .S ERROR="1^Error - MFE parameter XREF missing HLNODE: "_HLNODE
  1. .D EM^XUMFH(ERROR,.ERR)
  1. ;
  1. ;I IFN=4.001 D Q
  1. ;.S IEN=$$FIND1^DIC(1,,"BX",$P(PKV,HLCS))
  1. ;.I 'IEN D Q
  1. ;..S ERROR="1^not a valid IEN in MFE - HLNODE: "_HLNODE
  1. ;..D EM^XUMFH(ERROR,.ERR)
  1. ;.Q:$D(^DIC(4.001,IEN))
  1. ;.S NAME=$P(PKV,HLCS)
  1. ;.K FDA
  1. ;.S FDA(IFN,"?+1,",.01)=NAME
  1. ;.D UPDATE^DIE("E","FDA",,"ERR")
  1. ;.I $D(ERR) D Q
  1. ;..S ERROR="1^MFE UPDATE FAILED for .01 File#: "_IFN
  1. ;..D EM^XUMFH(ERROR,.ERR)
  1. ;
  1. ;lookup an active VUID
  1. S VUID=$P(PKV,HLCS)
  1. I $G(XUMFSDS)="1H" S VUID=$P(PKV,HLCS,4)
  1. S ROOT=$$ROOT^DILFD(IFN,,1)
  1. I '$L(ROOT) D Q
  1. .S ERROR="1^Error - MFE no root file#: "_IFN
  1. .D EM^XUMFH(ERROR,.ERR)
  1. S IEN=$O(@ROOT@("AMASTERVUID",VUID,1,0))
  1. ;
  1. ;reactivate an existing inactive VUID
  1. I 'IEN D
  1. .S IEN=$O(@ROOT@("AMASTERVUID",VUID,0,0)) Q:'IEN
  1. .K FDA,ERR
  1. .S IENS=IEN_","
  1. .S FDA(IFN,IENS,99.98)=1
  1. .D FILE^DIE("E","FDA","ERR")
  1. .I $D(ERR) D
  1. ..S ERROR="1^flag update error for IFN: "_IFN_" IEN: "_IEN_" PKV: "_PKV
  1. ..D EM^XUMFH(ERROR,.ERR)
  1. ..K ERR
  1. ;
  1. Q:IEN
  1. ;
  1. I $G(XUMFSDS)="1H",'IEN D Q
  1. .S ERROR="1^SDS history could not find owning record PKV: "_PKV
  1. .D EM^XUMFH(ERROR,.ERR)
  1. ;
  1. I 'IEN D
  1. .S KEY=$P(PKV,HLCS,4)
  1. .S IEN=$O(@ROOT@(XREF,KEY,0))
  1. ;
  1. I 'IEN D Q:ERROR
  1. .S NAME=$P(PKV,HLCS,2)
  1. .D CHK^DIE(IFN,.01,,NAME,.X)
  1. .I X="^" D Q
  1. ..S ERROR="1^Error - PKV .01 is invalid"_" File #: "_IFN_" PKV="_PKV
  1. ..D EM^XUMFH(ERROR,.ERR)
  1. .K DIC S DIC=IFN,DIC(0)="F" D FILE^DICN K DIC
  1. .I Y="-1" D Q
  1. ..S ERROR="1^stub entry for "_PKV_" failed PKV: "_PKV
  1. ..D EM^XUMFH(ERROR,.ERR)
  1. .S IEN=+Y
  1. ;
  1. S IENS=IEN_","
  1. ;
  1. I $L($P(MFE,U)),$P(MFE,U)'=99.99 Q
  1. S FDA(IFN,IENS,99.99)=$P(PKV,HLCS,1)
  1. S FDA(IFN,IENS,99.98)=1
  1. ;
  1. K ERR
  1. ;
  1. D FILE^DIE("E","FDA","ERR")
  1. I $D(ERR) D
  1. .S ERROR="1^VUID update error for IFN: "_IFN_" IEN: "_IEN_" PKV: "_PKV
  1. .D EM^XUMFH(ERROR,.ERR)
  1. .K ERR
  1. ;
  1. Q
  1. ;
  1. VUID(FILE,FIELD,VUID,X) ; -- If value type pointer and VUID may be used,
  1. ; get IEN and set it as internal value
  1. N XVUID,X1
  1. Q:'$L(FILE)!'FIELD!'$L(VUID) 0
  1. Q:$E(X,1,$L(VUID))'=VUID 0
  1. S XVUID=$E(X,$L(VUID)+1,$L(X))
  1. D FIELD^DID(FILE,FIELD,,"POINTER","X1")
  1. S X1=$G(X1("POINTER"))
  1. Q:'$L(X1) 0
  1. S X1=U_X1_"""AMASTERVUID"",XVUID,1,0)"
  1. S X1=$O(@X1)
  1. Q +X1
  1. ;
  1. VAL(FILE,FIELD,VUID,VALUE,IENS) ; convert to internal
  1. ;
  1. N RESULT,ERR
  1. ;
  1. I $L(VUID) D Q RESULT
  1. .I VUID="SDS" S VALUE=VUID_+VALUE
  1. .S RESULT=$$VUID(FILE,FIELD,VUID,VALUE)
  1. .I 'RESULT D
  1. ..S RESULT="^",ERROR="1^VUID lookup failed on "_VALUE
  1. ..D EM("VUID lookup failed on "_VALUE)
  1. ;
  1. I VALUE["\F\" F Q:VALUE'["\F\" D
  1. .S VALUE=$P(VALUE,"\F\")_"^"_$P(VALUE,"\F\",2,9999)
  1. I VALUE["\T\" F Q:VALUE'["\T\" D
  1. .S VALUE=$P(VALUE,"\T\")_"&"_$P(VALUE,"\T\",2,9999)
  1. ;
  1. D VAL^DIE(FILE,IENS,FIELD,,VALUE,.RESULT,,"ERR")
  1. I $D(ERR) D EM("validation error",.ERR)
  1. I RESULT="^" S ERROR="1^data validation error"
  1. ;
  1. Q RESULT
  1. ;
  1. EM(ERROR,ERR,XMSUB,XMY) ; -- error message
  1. ;
  1. N X,XMTEXT,XMDUZ,GROUP
  1. ;
  1. D MSG^DIALOG("AM",.X,80,,"ERR")
  1. ;
  1. S X(.1)="HL7 message ID: "_$G(HL("MID"))
  1. S X(.2)="",X(.3)=$G(ERROR)
  1. S X(.4)="",X(.5)="Key: "_$G(KEY),X(.6)=""
  1. S:$G(XMSUB)="" XMSUB="MFS ERROR/WARNING/INFO"
  1. S XMY("G.XUMF ERROR")="",XMDUZ=.5
  1. S GROUP=$P($G(^DIC(4.001,+IFN,0)),U,6)
  1. I GROUP'="" S GROUP="G."_GROUP,XMY(GROUP)=""
  1. S XMTEXT="X("
  1. ;
  1. M ^TMP("XUMF ERROR",$J,$O(^TMP("XUMF ERROR",$J,9999999999999),-1)+1)=X
  1. ;
  1. D ^XMD
  1. ;
  1. Q
  1. ;