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

LA7VHLU4.m

Go to the documentation of this file. 
  1. LA7VHLU4 ;VA/DALOI/JMC - HL7 segment builder utility ; 13-Aug-2013 09:09 ; MKK
  1.  ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,1018,64,1027,68,1033**;NOV 01, 1997
  1.  ;
  1.  ;
  1. INST(LA74,LA7FS,LA7ECH) ; Build institution field
  1.  ; Call with   LA74 = ien of institution in file #4
  1.  ;                    if null/undefined then use Kernel Site file.
  1.  ;            LA7FS = HL field separator
  1.  ;           LA7ECH = HL encoding characters
  1.  ;
  1.  ; Returns facility that performed the testing (ID^text^99VA4)
  1.  ;
  1.  N LA7NVAF,LA7X,LA7Y,LA7Z
  1.  ;
  1.  S LA74=$G(LA74),LA7ECH=$G(LA7ECH),LA7Y=""
  1.  ;
  1.  ; If no institution, use Kernel Site default
  1.  I LA74="" S LA74=+$$KSP^XUPARAM("INST")
  1.  ;
  1.  ; Check if this field has been built previously for this institution
  1.  I LA74'="",$D(^TMP($J,"LA7VHLU","99VA4",LA74,LA7FS_LA7ECH)) S LA7Y=^TMP($J,"LA7VHLU","99VA4",LA74,LA7FS_LA7ECH)
  1.  ;
  1.  ; Value passed not a pointer - only build 2nd component
  1.  I LA7Y="",LA74'="",LA74'=+LA74 D
  1.  . S $P(LA7Y,$E(LA7ECH,1),2)=$$CHKDATA^LA7VHLU3(LA74,LA7FS_LA7ECH)
  1.  ;
  1.  I LA7Y="",LA74>0,LA74=+LA74 D
  1.  . S LA7NVAF=$$NVAF^LA7VHLU2(LA74)
  1.  . ; Build id - VA station #/DMIS code
  1.  . I LA7NVAF<2 S LA7Y=$$ID^XUAF4($S(LA7NVAF=1:"DMIS",1:"VASTANUM"),LA74)
  1.  . ; Build name using field #100, otherwise #.01
  1.  . S LA7Z=$$NAME^XUAF4(LA74)
  1.  . S $P(LA7Y,$E(LA7ECH,1),2)=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
  1.  . ;
  1.  . S $P(LA7Y,$E(LA7ECH,1),3)="99VA4"
  1.  ;
  1.  ; Save this field to TMP global to use for subsequent calls.
  1.  S ^TMP($J,"LA7VHLU","99VA4",LA74,LA7FS_LA7ECH)=LA7Y
  1.  ;
  1.  Q LA7Y
  1.  ;
  1.  ;
  1. XAD(LA7FN,LA7DA,LA7DT,LA7FS,LA7ECH) ; Build extended address
  1.  ; Call with LA7FN = Source File number
  1.  ;                   Presently file #2 (PATIENT), #4 (INSTITUTION) or #200 (NEW PERSON)
  1.  ;           LA7DA = Entry in source file
  1.  ;           LA7DT = As of date in FileMan format
  1.  ;           LA7FS = HL field separator
  1.  ;          LA7ECH = HL encoding characters
  1.  ;
  1.  ; Returns extended address
  1.  ;
  1.  N LA7X,LA7Y,LA7Z
  1.  ;
  1.  S LA7Y=""
  1.  ;
  1.  ; Check if this field has been built previously for this institution
  1.  ;I LA7FN,LA7DA,$D(^TMP($J,"LA7VHLU","99VA4A",LA7FN,LA7DA,LA7FS_LA7ECH)) S LA7Y=^TMP($J,"LA7VHLU","99VA4A",LA7FN,LA7DA,LA7FS_LA7ECH)
  1.  ;
  1.  ; Build from file #2
  1.  I LA7Y="",LA7FN=2,LA7DA D
  1.  . N DFN,VAHOW,VAPA,VAERR,VAROOT,VATEST
  1.  . S DFN=LA7DA
  1.  . I LA7DT S (VATEST("ADD",9),VATEST("ADD",10))=LA7DT
  1.  . D ADD^VADPT
  1.  . I VAERR Q
  1.  . S $P(LA7Y,$E(LA7ECH),1)=$$CHKDATA^LA7VHLU3(VAPA(1),LA7FS_LA7ECH)
  1.  . S $P(LA7Y,$E(LA7ECH),2)=$$CHKDATA^LA7VHLU3(VAPA(2),LA7FS_LA7ECH)
  1.  . S $P(LA7Y,$E(LA7ECH),3)=$$CHKDATA^LA7VHLU3(VAPA(4),LA7FS_LA7ECH)
  1.  . S $P(LA7Y,$E(LA7ECH),4)=$$CHKDATA^LA7VHLU3($P(VAPA(5),"^",2),LA7FS_LA7ECH)
  1.  . S $P(LA7Y,$E(LA7ECH),5)=$$CHKDATA^LA7VHLU3(VAPA(11),LA7FS_LA7ECH)
  1.  . I VAPA(9) S $P(LA7Y,$E(LA7ECH),7)="C"
  1.  . E  S $P(LA7Y,$E(LA7ECH),7)="P"
  1.  . S $P(LA7Y,$E(LA7ECH),9)=$$CHKDATA^LA7VHLU3($P(VAPA(7),"^",2),LA7FS_LA7ECH)
  1.  ;
  1.  ; Get address info from file #4, add 2nd address line
  1.  ;  change state to pointer to file #5
  1.  I LA7Y="",LA7FN=4,LA7DA D
  1.  . S LA7Z=$$PADD^XUAF4(LA7DA)
  1.  . S LA7X=$P(LA7Z,"^"),$P(LA7X,"^",2)=$$WHAT^XUAF4(LA7DA,1.02)
  1.  . F I=1,2 I $P(LA7X,"^",I)'="" S $P(LA7X,"^",I)=$$CHKDATA^LA7VHLU3($P(LA7X,"^",I),LA7FS_LA7ECH)
  1.  . S LA7Z=$P(LA7Z,"^",2,4),$P(LA7Z,"^",2)=$$GET1^DIQ(4,LA7DA_",",.02,"I")
  1.  . S $P(LA7Z,"^")=$$CHKDATA^LA7VHLU3($P(LA7Z,"^"),LA7FS_LA7ECH)
  1.  . S LA7Y=$$HLADDR^HLFNC(LA7X,LA7Z,LA7ECH)
  1.  ;
  1.  I LA7Y="",LA7FN=200,LA7DA D
  1.  . Q
  1.  ;
  1.  ; Save this field to TMP global to use for subsequent calls.
  1.  I LA7Y'="" S ^TMP($J,"LA7VHLU","99VA4A",LA7FN,LA7DA,LA7FS_LA7ECH)=LA7Y
  1.  ;
  1.  Q LA7Y
  1.  ;
  1.  ;
  1. XON(LA7FN,LA7DA,LA7TYP,LA7FS,LA7ECH) ; Build extended composite name/id for organization
  1.  ; Call with LA7FN = Source File number
  1.  ;                   Presently #4 (INSTITUTION)
  1.  ;           LA7DA = Entry in source file
  1.  ;          LA7TYP = type of identifer (0/null=station #, 1=CLIA)
  1.  ;           LA7FS = HL field separator
  1.  ;          LA7ECH = HL encoding characters
  1.  ;           
  1.  ;
  1.  N LA7X,LA7Y,LA7Z
  1.  ;
  1.  S LA7Y="",LA7TYP=+$G(LA7TYP)
  1.  ;
  1.  ; Check if this field has been built previously for this institution
  1.  I LA7FN,LA7DA,$D(^TMP($J,"LA7VHLU","99VA4N",LA7FN,LA7DA,LA7TYP,LA7FS_LA7ECH)) S LA7Y=^TMP($J,"LA7VHLU","99VA4N",LA7FN,LA7DA,LA7TYP,LA7FS_LA7ECH)
  1.  ;
  1.  ; Build name using field #100, otherwise #.01
  1.  ; Send facility id in 3rd component if numeric - conform to standard.
  1.  I LA7Y="",LA7FN=4,LA7DA D
  1.  . S LA7Z(1)=$P($$NS^XUAF4(LA7DA),"^"),LA7Z(2)=$$WHAT^XUAF4(LA7DA,100)
  1.  . S $P(LA7Y,$E(LA7ECH,1),1)=$$CHKDATA^LA7VHLU3(LA7Z(1),LA7FS_LA7ECH)
  1.  . S $P(LA7Y,$E(LA7ECH,1),2)="D"
  1.  . S LA7X=$$RETFACID^LA7VHLU2(LA7DA,2,1)
  1.  . I LA7X'="" D
  1.  . . I LA7X?1.N S $P(LA7Y,$E(LA7ECH,1),3)=LA7X
  1.  . . S $P(LA7Y,$E(LA7ECH,1),10)=LA7X
  1.  . S $P(LA7Y,$E(LA7ECH,1),6)="USVHA"
  1.  . S $P(LA7Y,$E(LA7ECH,1),7)="FI"
  1.  . S $P(LA7Y,$E(LA7ECH,1),9)="A"
  1.  . I LA7Z(2)'="" D
  1.  . . S $P(LA7Y,$E(LA7ECH,1),1)=$$CHKDATA^LA7VHLU3(LA7Z(2),LA7FS_LA7ECH)
  1.  . . S $P(LA7Y,$E(LA7ECH,1),2)="L"
  1.  . I LA7TYP=1 D
  1.  . . S LA7X=$$ID^XUAF4("CLIA",LA7DA) Q:LA7X=""
  1.  . . S $P(LA7Y,$E(LA7ECH,1),3)=""
  1.  . . S $P(LA7Y,$E(LA7ECH,1),6)="CLIA"
  1.  . . S $P(LA7Y,$E(LA7ECH,1),7)="LN"
  1.  . . S $P(LA7Y,$E(LA7ECH,1),10)=LA7X
  1.  ;
  1.  ; Save this field to TMP global to use for subsequent calls.
  1.  I LA7Y'="" S ^TMP($J,"LA7VHLU","99VA4N",LA7FN,LA7DA,LA7TYP,LA7FS_LA7ECH)=LA7Y
  1.  ;
  1.  Q LA7Y
  1.  ;
  1.  ;
  1. XCNTFM(LA7X,LA7ECH) ; Resolve XCN data type to FileMan (last name, first name, mi [id])
  1.  ; Call with LA7X = HL7 field containing name
  1.  ;         LA7ECH = HL7 encoding characters
  1.  ;
  1.  ; Returns   LA7Y = ID code^DUZ^FileMan name (DUZ=0 if name not found on local system).
  1.  ; Stub until all calls can be converted to call XCNTFM^LA7VHLU9
  1.  ;
  1.  Q $$XCNTFM^LA7VHLU9(LA7X,LA7ECH)
  1.  ;
  1.  ;
  1. PLTFM(LA7PL,LA7ECH) ; Resolve location from PL (person location) data type.
  1.  ; Call with LA7PL = HL7 field containing person location
  1.  ;          LA7ECH = HL7 encoding characters
  1.  ;
  1.  ; Returns    LA7Y = file #44 ien^name field (#.01)^division(institution)
  1.  ;
  1.  N LA7X,LA7Y,X,Y
  1.  S LA7X=$P(LA7PL,$E(LA7ECH)),(LA7Y,Y)=""
  1.  I LA7X?1.N S Y=$$GET1^DIQ(44,LA7X_",",.01)
  1.  ; If not ien try as name
  1.  I Y="" D
  1.  . S X=$$FIND1^DIC(44,"","X",LA7X,"B")
  1.  . I X S Y=LA7X,LA7X=X
  1.  I Y'="" S LA7Y=LA7X_"^"_Y
  1.  E  I $P(LA7PL,$E(LA7ECH),2)'="" S LA7Y="^"_$P(LA7PL,$E(LA7ECH),2)
  1.  ;
  1.  ; Process division (institution) - pass 1st sub-component of 4th component
  1.  S LA7X=$P(LA7PL,$E(LA7ECH),4)
  1.  S LA7X=$P(LA7X,$E(LA7ECH,4))
  1.  S Y=""
  1.  I LA7X'="" S Y=$$FINDSITE^LA7VHLU2(LA7X,1,1)
  1.  S $P(LA7Y,"^",3)=Y
  1.  ;
  1.  Q LA7Y