- VAFCAAUT ;BIR/CML-VAFC ASSIGNING AUTHORITY FILE (#391.92) Utilities ; 7/13/10
- ;;5.3;Registration;**825**;Aug 13, 1993;Build 1
- Q
- ;
- GETIEN(ASSIGNAU) ;
- ; for MPIC_2006
- ; Get IEN of record in the VAFC ASSIGNING AUTHORITY FILE (#391.92).
- ;
- ; Input:
- ; ASSIGNAU: Assigning Authority
- ; example of ASSIGNAU="1.3.6.1.4.1.26580" for HL7 v3.
- ; example of ASSIGNAU="USDOD" for HL7 v2.4.
- ;
- ; Return: 1) ien of MPI Assigning Authority (#985.55) file
- ; 2) -1^<comment> if the input is bad or there is an ambiguity
- ;
- ; Example:<ien>
- ; Example:"-1^Not found"
- ; Example:"-1^Invalid input"
- ; Example:"-1^More than one ien found^<ien #1>^<ien #2>..."
- ;
- N AA,IEN,INDEX,LIST,RESULT
- ;
- ; Check input parameter
- S AA=$G(ASSIGNAU)
- Q:AA="" "-1^Invalid input"
- ;
- ; Build a list of IENs found in the v2.4 and v3.0 indexes
- ; making sure each IEN is added only once.
- F INDEX="HL24","HL3" D
- .S IEN=0 F S IEN=$O(^DGCN(391.92,INDEX,AA,IEN)) Q:'IEN D
- ..Q:$G(LIST)[("^"_IEN_"^")
- ..S LIST=$S($G(LIST)="":"^",1:LIST)_IEN_"^"
- ;
- ; Remove leading and trailing "^"
- S:$G(LIST)["^" LIST=$E(LIST,2,$L(LIST)-1)
- ;
- ; Set the result
- I $G(LIST)="" S RESULT="-1^Not found" Q RESULT
- I $G(LIST)["^" S RESULT="-1^More than one ien found^"_LIST Q RESULT
- S RESULT=LIST
- ;
- Q RESULT
- ;
- ADD(ARRAY,ERROR) ;API to add an entry to the VAFC ASSIGNING AUTHORITY FILE (#391.92) ;**825, MPIC_2007
- ;
- ;Acceptable input scenarios:
- ;HL7V2_4 only and no SOURCEID,
- ;HL7V2_4 and HL7V3_0 and no SOURCEID, or
- ;HL7V3_0 only and SOURCEID
- ;
- ;Input ARRAY:
- ; ARRAY("HL7V2_4")= value for HL7V2_4 (#.02) field AND/OR
- ; ARRAY("HL7V3_0")= value for HL7V3_0 (#.03) field
- ; ARRAY("SOURCEID")= value for DEFAULT SOURCE ID TYPE (#.04) field
- ;
- ;Output:
- ; -1^error text - record add failed
- ; or
- ; IEN of the entry (new or previously existing)
- ;
- ; Example: S ARRAY("HL7V3_0")="1234.5678.9876"
- ; S ARRAY("SOURCEID")="NI"
- ; S VAL=$$ADD^VAFCAAUT(.ARRAY,.ERR)
- ; VAL=6
- ;
- ;Check incoming data for invalid input
- N FLD02,FLD03,FOUND,IEN,JJ,PC,RESULT,SRC,SRCID,SRCVAL
- S RESULT="-1^Invalid input parameter. ",SRCID=""
- I '$D(ARRAY) Q RESULT ;No input data
- ;Don't accept null input values
- I $D(ARRAY("HL7V2_4")) I ARRAY("HL7V2_4")="" Q RESULT
- I $D(ARRAY("HL7V3_0")) I ARRAY("HL7V3_0")="" Q RESULT
- I $D(ARRAY("SOURCEID")) I ARRAY("SOURCEID")="" Q RESULT
- ;
- ;Must have either HL7_2.4 OR HL7_3.0 value input
- I '$D(ARRAY("HL7V2_4"))&('$D(ARRAY("HL7V3_0"))) S RESULT=RESULT_"Assigning Authority value missing." Q RESULT
- ;If both HL7_2.4 and HL7_3.0 values input, there must be NO SOURCEID
- 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
- ;If HL7V2_4 value input but not HL7V3_0, there must be NO SOURCEID
- 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
- ;If HL7V3_0 value input but not HL7V2_4, then SOURCEID must be present
- I '$D(ARRAY("HL7V2_4"))&($D(ARRAY("HL7V3_0"))) D SOURCE I 'SRCID S RESULT=RESULT_"SOURCEID value missing." Q RESULT
- ;
- ;If SOURCEID passed in, must have valid value
- I $D(ARRAY("SOURCEID")) S FOUND=0 D I 'FOUND S RESULT=RESULT_"Invalid SOURCEID value passed in." Q RESULT
- .S SRCVAL=$$GET1^DID(391.92,.04,"","POINTER","","MSG") ;valid values
- .F PC=1:1:($L(SRCVAL,";")-1) S SRC=$P($P(SRCVAL,";",PC),":") I ARRAY("SOURCEID")=SRC S FOUND=1
- ;
- ;If HL7V2_4 value passed in, must have valid value
- I $D(ARRAY("HL7V2_4")) D I $L(ARRAY("HL7V2_4"))>FLD02("FIELD LENGTH") S RESULT=RESULT_"Assigning Authority value too long." Q RESULT
- .D FIELD^DID(391.92,.02,"","FIELD LENGTH","FLD02")
- ;Ensure that HL7V2_4 value passed in is upper case.
- I $D(ARRAY("HL7V2_4")) S ARRAY("HL7V2_4")=$$UP^XLFSTR(ARRAY("HL7V2_4"))
- ;If HL7V3_0 value passed in, must have valid value
- I $D(ARRAY("HL7V3_0")) D I $L(ARRAY("HL7V3_0"))>FLD03("FIELD LENGTH") S RESULT=RESULT_"Assigning Authority value too long." Q RESULT
- .D FIELD^DID(391.92,.03,"","FIELD LENGTH","FLD03")
- I $D(ARRAY("HL7V3_0")) I ARRAY("HL7V3_0")'?1N.NP S RESULT=RESULT_"HL73_0 value must contain only numerics/punctuation." Q RESULT
- ;
- ;Is entry already in the file? If so, quit with that IEN
- S FOUND=0 F JJ="HL7V2_4","HL7V3_0" I $D(ARRAY(JJ)) S IEN=$$GETIEN^VAFCAAUT(ARRAY(JJ)) D I FOUND Q
- .I $P(IEN,"^")>0 S RESULT=IEN S FOUND=1 Q
- .;Remote possibility that the GETIEN API will return an anomaly
- .I $P(IEN,"^",2)="More than one ien found" S RESULT=IEN S FOUND=1 Q ;Anomaly - should not happen
- .;otherwise ien="-1^Not found", code will fall into module below
- I FOUND Q RESULT
- ;
- ;Good input data, and entry does not already exist
- ;Add entry to VAFC ASSIGNING AUTHORITY FILE (#391.92)
- N DIC,DINUM,DR,LAST,X,Y
- L +^DGCN(391.92,0):600
- S (LAST,X)=0
- S LAST=+$O(^DGCN(391.92,"@"),-1) ;Last entry # in file
- S (X,DINUM)=LAST+1 ;Next available #
- S DIC="^DGCN(391.92,",DIC(0)="FZ"
- ;Set up DR string
- I $D(ARRAY("HL7V2_4")) S DIC("DR")=".02///^S X=ARRAY(""HL7V2_4"")"_";"
- I $D(ARRAY("HL7V3_0")) S DIC("DR")=$G(DIC("DR"))_".03///^S X=ARRAY(""HL7V3_0"")"_";"
- I $D(ARRAY("SOURCEID")) S DIC("DR")=$G(DIC("DR"))_".04///^S X=ARRAY(""SOURCEID"")"_";"
- ;
- K DO D FILE^DICN K DO
- L -^DGCN(391.92,0)
- I +Y=-1 S RESULT="-1^Unable to create new entry in the VAFC ASSIGNING AUTHORITY FILE (#391.92)." Q RESULT
- S RESULT=+Y
- Q RESULT
- ;
- SOURCE ;Is SOURCEID defined?
- S SRCID=$S($D(ARRAY("SOURCEID")):1,1:0)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFCAAUT 5633 printed Jan 18, 2025@04:02:07 Page 2
- VAFCAAUT ;BIR/CML-VAFC ASSIGNING AUTHORITY FILE (#391.92) Utilities ; 7/13/10
- +1 ;;5.3;Registration;**825**;Aug 13, 1993;Build 1
- +2 QUIT
- +3 ;
- GETIEN(ASSIGNAU) ;
- +1 ; for MPIC_2006
- +2 ; Get IEN of record in the VAFC ASSIGNING AUTHORITY FILE (#391.92).
- +3 ;
- +4 ; Input:
- +5 ; ASSIGNAU: Assigning Authority
- +6 ; example of ASSIGNAU="1.3.6.1.4.1.26580" for HL7 v3.
- +7 ; example of ASSIGNAU="USDOD" for HL7 v2.4.
- +8 ;
- +9 ; Return: 1) ien of MPI Assigning Authority (#985.55) file
- +10 ; 2) -1^<comment> if the input is bad or there is an ambiguity
- +11 ;
- +12 ; Example:<ien>
- +13 ; Example:"-1^Not found"
- +14 ; Example:"-1^Invalid input"
- +15 ; Example:"-1^More than one ien found^<ien #1>^<ien #2>..."
- +16 ;
- +17 NEW AA,IEN,INDEX,LIST,RESULT
- +18 ;
- +19 ; Check input parameter
- +20 SET AA=$GET(ASSIGNAU)
- +21 if AA=""
- QUIT "-1^Invalid input"
- +22 ;
- +23 ; Build a list of IENs found in the v2.4 and v3.0 indexes
- +24 ; making sure each IEN is added only once.
- +25 FOR INDEX="HL24","HL3"
- Begin DoDot:1
- +26 SET IEN=0
- FOR
- SET IEN=$ORDER(^DGCN(391.92,INDEX,AA,IEN))
- if 'IEN
- QUIT
- Begin DoDot:2
- +27 if $GET(LIST)[("^"_IEN_"^")
- QUIT
- +28 SET LIST=$SELECT($GET(LIST)="":"^",1:LIST)_IEN_"^"
- End DoDot:2
- End DoDot:1
- +29 ;
- +30 ; Remove leading and trailing "^"
- +31 if $GET(LIST)["^"
- SET LIST=$EXTRACT(LIST,2,$LENGTH(LIST)-1)
- +32 ;
- +33 ; Set the result
- +34 IF $GET(LIST)=""
- SET RESULT="-1^Not found"
- QUIT RESULT
- +35 IF $GET(LIST)["^"
- SET RESULT="-1^More than one ien found^"_LIST
- QUIT RESULT
- +36 SET RESULT=LIST
- +37 ;
- +38 QUIT RESULT
- +39 ;
- ADD(ARRAY,ERROR) ;API to add an entry to the VAFC ASSIGNING AUTHORITY FILE (#391.92) ;**825, MPIC_2007
- +1 ;
- +2 ;Acceptable input scenarios:
- +3 ;HL7V2_4 only and no SOURCEID,
- +4 ;HL7V2_4 and HL7V3_0 and no SOURCEID, or
- +5 ;HL7V3_0 only and SOURCEID
- +6 ;
- +7 ;Input ARRAY:
- +8 ; ARRAY("HL7V2_4")= value for HL7V2_4 (#.02) field AND/OR
- +9 ; ARRAY("HL7V3_0")= value for HL7V3_0 (#.03) field
- +10 ; ARRAY("SOURCEID")= value for DEFAULT SOURCE ID TYPE (#.04) field
- +11 ;
- +12 ;Output:
- +13 ; -1^error text - record add failed
- +14 ; or
- +15 ; IEN of the entry (new or previously existing)
- +16 ;
- +17 ; Example: S ARRAY("HL7V3_0")="1234.5678.9876"
- +18 ; S ARRAY("SOURCEID")="NI"
- +19 ; S VAL=$$ADD^VAFCAAUT(.ARRAY,.ERR)
- +20 ; VAL=6
- +21 ;
- +22 ;Check incoming data for invalid input
- +23 NEW FLD02,FLD03,FOUND,IEN,JJ,PC,RESULT,SRC,SRCID,SRCVAL
- +24 SET RESULT="-1^Invalid input parameter. "
- SET SRCID=""
- +25 ;No input data
- IF '$DATA(ARRAY)
- QUIT RESULT
- +26 ;Don't accept null input values
- +27 IF $DATA(ARRAY("HL7V2_4"))
- IF ARRAY("HL7V2_4")=""
- QUIT RESULT
- +28 IF $DATA(ARRAY("HL7V3_0"))
- IF ARRAY("HL7V3_0")=""
- QUIT RESULT
- +29 IF $DATA(ARRAY("SOURCEID"))
- IF ARRAY("SOURCEID")=""
- QUIT RESULT
- +30 ;
- +31 ;Must have either HL7_2.4 OR HL7_3.0 value input
- +32 IF '$DATA(ARRAY("HL7V2_4"))&('$DATA(ARRAY("HL7V3_0")))
- SET RESULT=RESULT_"Assigning Authority value missing."
- QUIT RESULT
- +33 ;If both HL7_2.4 and HL7_3.0 values input, there must be NO SOURCEID
- +34 IF $DATA(ARRAY("HL7V2_4"))&($DATA(ARRAY("HL7V3_0")))
- DO SOURCE
- IF SRCID
- SET RESULT=RESULT_"SOURCEID value must not be passed in."
- QUIT RESULT
- +35 ;If HL7V2_4 value input but not HL7V3_0, there must be NO SOURCEID
- +36 IF $DATA(ARRAY("HL7V2_4"))&('$DATA(ARRAY("HL7V3_0")))
- DO SOURCE
- IF SRCID
- SET RESULT=RESULT_"SOURCEID value must not be passed in."
- QUIT RESULT
- +37 ;If HL7V3_0 value input but not HL7V2_4, then SOURCEID must be present
- +38 IF '$DATA(ARRAY("HL7V2_4"))&($DATA(ARRAY("HL7V3_0")))
- DO SOURCE
- IF 'SRCID
- SET RESULT=RESULT_"SOURCEID value missing."
- QUIT RESULT
- +39 ;
- +40 ;If SOURCEID passed in, must have valid value
- +41 IF $DATA(ARRAY("SOURCEID"))
- SET FOUND=0
- Begin DoDot:1
- +42 ;valid values
- SET SRCVAL=$$GET1^DID(391.92,.04,"","POINTER","","MSG")
- +43 FOR PC=1:1:($LENGTH(SRCVAL,";")-1)
- SET SRC=$PIECE($PIECE(SRCVAL,";",PC),":")
- IF ARRAY("SOURCEID")=SRC
- SET FOUND=1
- End DoDot:1
- IF 'FOUND
- SET RESULT=RESULT_"Invalid SOURCEID value passed in."
- QUIT RESULT
- +44 ;
- +45 ;If HL7V2_4 value passed in, must have valid value
- +46 IF $DATA(ARRAY("HL7V2_4"))
- Begin DoDot:1
- +47 DO FIELD^DID(391.92,.02,"","FIELD LENGTH","FLD02")
- End DoDot:1
- IF $LENGTH(ARRAY("HL7V2_4"))>FLD02("FIELD LENGTH")
- SET RESULT=RESULT_"Assigning Authority value too long."
- QUIT RESULT
- +48 ;Ensure that HL7V2_4 value passed in is upper case.
- +49 IF $DATA(ARRAY("HL7V2_4"))
- SET ARRAY("HL7V2_4")=$$UP^XLFSTR(ARRAY("HL7V2_4"))
- +50 ;If HL7V3_0 value passed in, must have valid value
- +51 IF $DATA(ARRAY("HL7V3_0"))
- Begin DoDot:1
- +52 DO FIELD^DID(391.92,.03,"","FIELD LENGTH","FLD03")
- End DoDot:1
- IF $LENGTH(ARRAY("HL7V3_0"))>FLD03("FIELD LENGTH")
- SET RESULT=RESULT_"Assigning Authority value too long."
- QUIT RESULT
- +53 IF $DATA(ARRAY("HL7V3_0"))
- IF ARRAY("HL7V3_0")'?1N.NP
- SET RESULT=RESULT_"HL73_0 value must contain only numerics/punctuation."
- QUIT RESULT
- +54 ;
- +55 ;Is entry already in the file? If so, quit with that IEN
- +56 SET FOUND=0
- FOR JJ="HL7V2_4","HL7V3_0"
- IF $DATA(ARRAY(JJ))
- SET IEN=$$GETIEN^VAFCAAUT(ARRAY(JJ))
- Begin DoDot:1
- +57 IF $PIECE(IEN,"^")>0
- SET RESULT=IEN
- SET FOUND=1
- QUIT
- +58 ;Remote possibility that the GETIEN API will return an anomaly
- +59 ;Anomaly - should not happen
- IF $PIECE(IEN,"^",2)="More than one ien found"
- SET RESULT=IEN
- SET FOUND=1
- QUIT
- +60 ;otherwise ien="-1^Not found", code will fall into module below
- End DoDot:1
- IF FOUND
- QUIT
- +61 IF FOUND
- QUIT RESULT
- +62 ;
- +63 ;Good input data, and entry does not already exist
- +64 ;Add entry to VAFC ASSIGNING AUTHORITY FILE (#391.92)
- +65 NEW DIC,DINUM,DR,LAST,X,Y
- +66 LOCK +^DGCN(391.92,0):600
- +67 SET (LAST,X)=0
- +68 ;Last entry # in file
- SET LAST=+$ORDER(^DGCN(391.92,"@"),-1)
- +69 ;Next available #
- SET (X,DINUM)=LAST+1
- +70 SET DIC="^DGCN(391.92,"
- SET DIC(0)="FZ"
- +71 ;Set up DR string
- +72 IF $DATA(ARRAY("HL7V2_4"))
- SET DIC("DR")=".02///^S X=ARRAY(""HL7V2_4"")"_";"
- +73 IF $DATA(ARRAY("HL7V3_0"))
- SET DIC("DR")=$GET(DIC("DR"))_".03///^S X=ARRAY(""HL7V3_0"")"_";"
- +74 IF $DATA(ARRAY("SOURCEID"))
- SET DIC("DR")=$GET(DIC("DR"))_".04///^S X=ARRAY(""SOURCEID"")"_";"
- +75 ;
- +76 KILL DO
- DO FILE^DICN
- KILL DO
- +77 LOCK -^DGCN(391.92,0)
- +78 IF +Y=-1
- SET RESULT="-1^Unable to create new entry in the VAFC ASSIGNING AUTHORITY FILE (#391.92)."
- QUIT RESULT
- +79 SET RESULT=+Y
- +80 QUIT RESULT
- +81 ;
- SOURCE ;Is SOURCEID defined?
- +1 SET SRCID=$SELECT($DATA(ARRAY("SOURCEID")):1,1:0)
- +2 QUIT