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

VAFCAAUT.m

Go to the documentation of this file.
  1. VAFCAAUT ;BIR/CML-VAFC ASSIGNING AUTHORITY FILE (#391.92) Utilities ; 7/13/10
  1. ;;5.3;Registration;**825**;Aug 13, 1993;Build 1
  1. Q
  1. ;
  1. GETIEN(ASSIGNAU) ;
  1. ; for MPIC_2006
  1. ; Get IEN of record in the VAFC ASSIGNING AUTHORITY FILE (#391.92).
  1. ;
  1. ; Input:
  1. ; ASSIGNAU: Assigning Authority
  1. ; example of ASSIGNAU="1.3.6.1.4.1.26580" for HL7 v3.
  1. ; example of ASSIGNAU="USDOD" for HL7 v2.4.
  1. ;
  1. ; Return: 1) ien of MPI Assigning Authority (#985.55) file
  1. ; 2) -1^<comment> if the input is bad or there is an ambiguity
  1. ;
  1. ; Example:<ien>
  1. ; Example:"-1^Not found"
  1. ; Example:"-1^Invalid input"
  1. ; Example:"-1^More than one ien found^<ien #1>^<ien #2>..."
  1. ;
  1. N AA,IEN,INDEX,LIST,RESULT
  1. ;
  1. ; Check input parameter
  1. S AA=$G(ASSIGNAU)
  1. Q:AA="" "-1^Invalid input"
  1. ;
  1. ; Build a list of IENs found in the v2.4 and v3.0 indexes
  1. ; making sure each IEN is added only once.
  1. F INDEX="HL24","HL3" D
  1. .S IEN=0 F S IEN=$O(^DGCN(391.92,INDEX,AA,IEN)) Q:'IEN D
  1. ..Q:$G(LIST)[("^"_IEN_"^")
  1. ..S LIST=$S($G(LIST)="":"^",1:LIST)_IEN_"^"
  1. ;
  1. ; Remove leading and trailing "^"
  1. S:$G(LIST)["^" LIST=$E(LIST,2,$L(LIST)-1)
  1. ;
  1. ; Set the result
  1. I $G(LIST)="" S RESULT="-1^Not found" Q RESULT
  1. I $G(LIST)["^" S RESULT="-1^More than one ien found^"_LIST Q RESULT
  1. S RESULT=LIST
  1. ;
  1. Q RESULT
  1. ;
  1. ADD(ARRAY,ERROR) ;API to add an entry to the VAFC ASSIGNING AUTHORITY FILE (#391.92) ;**825, MPIC_2007
  1. ;
  1. ;Acceptable input scenarios:
  1. ;HL7V2_4 only and no SOURCEID,
  1. ;HL7V2_4 and HL7V3_0 and no SOURCEID, or
  1. ;HL7V3_0 only and SOURCEID
  1. ;
  1. ;Input ARRAY:
  1. ; ARRAY("HL7V2_4")= value for HL7V2_4 (#.02) field AND/OR
  1. ; ARRAY("HL7V3_0")= value for HL7V3_0 (#.03) field
  1. ; ARRAY("SOURCEID")= value for DEFAULT SOURCE ID TYPE (#.04) field
  1. ;
  1. ;Output:
  1. ; -1^error text - record add failed
  1. ; or
  1. ; IEN of the entry (new or previously existing)
  1. ;
  1. ; Example: S ARRAY("HL7V3_0")="1234.5678.9876"
  1. ; S ARRAY("SOURCEID")="NI"
  1. ; S VAL=$$ADD^VAFCAAUT(.ARRAY,.ERR)
  1. ; VAL=6
  1. ;
  1. ;Check incoming data for invalid input
  1. N FLD02,FLD03,FOUND,IEN,JJ,PC,RESULT,SRC,SRCID,SRCVAL
  1. S RESULT="-1^Invalid input parameter. ",SRCID=""
  1. I '$D(ARRAY) Q RESULT ;No input data
  1. ;Don't accept null input values
  1. I $D(ARRAY("HL7V2_4")) I ARRAY("HL7V2_4")="" Q RESULT
  1. I $D(ARRAY("HL7V3_0")) I ARRAY("HL7V3_0")="" Q RESULT
  1. I $D(ARRAY("SOURCEID")) I ARRAY("SOURCEID")="" Q RESULT
  1. ;
  1. ;Must have either HL7_2.4 OR HL7_3.0 value input
  1. I '$D(ARRAY("HL7V2_4"))&('$D(ARRAY("HL7V3_0"))) S RESULT=RESULT_"Assigning Authority value missing." Q RESULT
  1. ;If both HL7_2.4 and HL7_3.0 values input, there must be NO SOURCEID
  1. I $D(ARRAY("HL7V2_4"))&($D(ARRAY("HL7V3_0"))) D SOURCE I SRCID S RESULT=RESULT_"SOURCEID value must not be passed in." Q RESULT
  1. ;If HL7V2_4 value input but not HL7V3_0, there must be NO SOURCEID
  1. I $D(ARRAY("HL7V2_4"))&('$D(ARRAY("HL7V3_0"))) D SOURCE I SRCID S RESULT=RESULT_"SOURCEID value must not be passed in." Q RESULT
  1. ;If HL7V3_0 value input but not HL7V2_4, then SOURCEID must be present
  1. I '$D(ARRAY("HL7V2_4"))&($D(ARRAY("HL7V3_0"))) D SOURCE I 'SRCID S RESULT=RESULT_"SOURCEID value missing." Q RESULT
  1. ;
  1. ;If SOURCEID passed in, must have valid value
  1. I $D(ARRAY("SOURCEID")) S FOUND=0 D I 'FOUND S RESULT=RESULT_"Invalid SOURCEID value passed in." Q RESULT
  1. .S SRCVAL=$$GET1^DID(391.92,.04,"","POINTER","","MSG") ;valid values
  1. .F PC=1:1:($L(SRCVAL,";")-1) S SRC=$P($P(SRCVAL,";",PC),":") I ARRAY("SOURCEID")=SRC S FOUND=1
  1. ;
  1. ;If HL7V2_4 value passed in, must have valid value
  1. I $D(ARRAY("HL7V2_4")) D I $L(ARRAY("HL7V2_4"))>FLD02("FIELD LENGTH") S RESULT=RESULT_"Assigning Authority value too long." Q RESULT
  1. .D FIELD^DID(391.92,.02,"","FIELD LENGTH","FLD02")
  1. ;Ensure that HL7V2_4 value passed in is upper case.
  1. I $D(ARRAY("HL7V2_4")) S ARRAY("HL7V2_4")=$$UP^XLFSTR(ARRAY("HL7V2_4"))
  1. ;If HL7V3_0 value passed in, must have valid value
  1. I $D(ARRAY("HL7V3_0")) D I $L(ARRAY("HL7V3_0"))>FLD03("FIELD LENGTH") S RESULT=RESULT_"Assigning Authority value too long." Q RESULT
  1. .D FIELD^DID(391.92,.03,"","FIELD LENGTH","FLD03")
  1. I $D(ARRAY("HL7V3_0")) I ARRAY("HL7V3_0")'?1N.NP S RESULT=RESULT_"HL73_0 value must contain only numerics/punctuation." Q RESULT
  1. ;
  1. ;Is entry already in the file? If so, quit with that IEN
  1. S FOUND=0 F JJ="HL7V2_4","HL7V3_0" I $D(ARRAY(JJ)) S IEN=$$GETIEN^VAFCAAUT(ARRAY(JJ)) D I FOUND Q
  1. .I $P(IEN,"^")>0 S RESULT=IEN S FOUND=1 Q
  1. .;Remote possibility that the GETIEN API will return an anomaly
  1. .I $P(IEN,"^",2)="More than one ien found" S RESULT=IEN S FOUND=1 Q ;Anomaly - should not happen
  1. .;otherwise ien="-1^Not found", code will fall into module below
  1. I FOUND Q RESULT
  1. ;
  1. ;Good input data, and entry does not already exist
  1. ;Add entry to VAFC ASSIGNING AUTHORITY FILE (#391.92)
  1. N DIC,DINUM,DR,LAST,X,Y
  1. L +^DGCN(391.92,0):600
  1. S (LAST,X)=0
  1. S LAST=+$O(^DGCN(391.92,"@"),-1) ;Last entry # in file
  1. S (X,DINUM)=LAST+1 ;Next available #
  1. S DIC="^DGCN(391.92,",DIC(0)="FZ"
  1. ;Set up DR string
  1. I $D(ARRAY("HL7V2_4")) S DIC("DR")=".02///^S X=ARRAY(""HL7V2_4"")"_";"
  1. I $D(ARRAY("HL7V3_0")) S DIC("DR")=$G(DIC("DR"))_".03///^S X=ARRAY(""HL7V3_0"")"_";"
  1. I $D(ARRAY("SOURCEID")) S DIC("DR")=$G(DIC("DR"))_".04///^S X=ARRAY(""SOURCEID"")"_";"
  1. ;
  1. K DO D FILE^DICN K DO
  1. L -^DGCN(391.92,0)
  1. I +Y=-1 S RESULT="-1^Unable to create new entry in the VAFC ASSIGNING AUTHORITY FILE (#391.92)." Q RESULT
  1. S RESULT=+Y
  1. Q RESULT
  1. ;
  1. SOURCE ;Is SOURCEID defined?
  1. S SRCID=$S($D(ARRAY("SOURCEID")):1,1:0)
  1. Q