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

VIABEFR.m

Go to the documentation of this file.
  1. VIABEFR ;AAC/JMC - VIA EFR RPCs ;05/17/2016
  1. ;;1.0;VISTA INTEGRATION ADAPTER;**9**;06-FEB-2014;Build 1
  1. ;
  1. ;The following RPC is in support of the Embedded Fragment Registry (EFR). This RPC reads data from the
  1. ;RESEARCH File #67.1 and the LAB DATA File #63.
  1. ;
  1. ; RPC VIAB EFR
  1. ; ICR 2052 Database Server API: Data Dictionary Utilities
  1. ; ICR 6743 VIAB LAB [File 63, "CH" node] (private)
  1. ; ICR 6476 RESEARCH [File #67.1, fields #.01,9,63] (private)
  1. ;
  1. Q
  1. ;
  1. EN(RESULT,VIA) ; entry point for RPC
  1. D PARSE(.VIA)
  1. D TMP
  1. D DTCHK
  1. D LAB671
  1. D KVAR
  1. Q
  1. ;
  1. PARSE(VIA) ; -- array parsing to parameters and initializing variables
  1. ;Input parameters
  1. ; VIA("FROM")=value to start from in Files #67.1 & #63.04 [optional]
  1. ; VIA("SDATE")=Start Date for search [optional]
  1. ; VIA("EDATE")=End Date for search [optional]
  1. ; VIA("IDS")=List of Patient Identifiers separated by a semicolon [optional]
  1. ; VIA("FIELDS")=list of extra fields to return data, separate by semicolon (;)[optional]
  1. ; Example: VIA("FIELDS")="631807;631568;631567;631007;631808;631798;631799;631800;631801;631809"
  1. ; VIA("MAX")=n [optional]
  1. N SFLDS,IFLDS,I,X
  1. S VIAFIELDS=$G(VIA("FIELDS"))
  1. S VIAMAX=$G(VIA("MAX")) I VIAMAX>1000 S VIAMAX=1000
  1. I $G(VIAMAX)="" S VIAMAX=1000
  1. S VIAFROM=$G(VIA("FROM"))
  1. S VIABFRM=VIAFROM
  1. S VIASDT=$G(VIA("SDATE"))
  1. S VIAEDT=$G(VIA("EDATE"))
  1. S VIAIDS=$G(VIA("IDS"))
  1. Q
  1. ;
  1. TMP ; -- temporary environment variables sets until kernel tools arrives
  1. IF '$G(DUZ) D
  1. . S DUZ=.5,DUZ(0)="@",U="^",DTIME=300
  1. . D NOW^%DTC S DT=X
  1. Q
  1. ;
  1. LAB671 ; -- returns a list of lab identifiers from RESEARCH File #67.1
  1. ; Builds the ^TMP("VIABEFR",$J) array
  1. ; ^TMP("VIABEFR",$J,1)="[Data"] or if there is an error ^TMP("VIABEFR",$J,1)="[Errors"]
  1. ; ^TMP("VIABEFR",$J,n)=67.1:IEN^.01 NAME^9 IDENTIFIER^63 LABORATORY REFERENCE
  1. ; where n is a numeric value starting from 2
  1. ;
  1. N VIACNT,VIA671,IENS,QFLG,LRIEN,VIAC,XREF,STR671
  1. K ^TMP("VIABEFR",$J)
  1. S VIAC=1,(VIACNT,QFLG)=0
  1. S ^TMP("VIABEFR",$J,1)="[Data]"
  1. I VIAIDS'="" D IDS Q
  1. I VIAFROM'="" S VIAFROM=$$STRTFRM() I VIAFROM="" D Q
  1. . S ^TMP("VIABEFR",$J,1)="[Errors]"
  1. . S ^TMP("VIABEFR",$J,2)="Starting Entry not found" K RESULT S RESULT=$NA(^TMP("VIABEFR",$J)) Q
  1. S XREF=$S(VIAFROM'="":VIAFROM,1:"")
  1. F S XREF=$O(^LRT(67.1,"B",XREF)) Q:XREF="" D I QFLG Q
  1. . S IENS=0 F S IENS=$O(^LRT(67.1,"B",XREF,IENS)) Q:'IENS D I QFLG Q
  1. . . S LRIEN=$$GET1^DIQ(67.1,IENS,63,"I") I LRIEN="" Q
  1. . . S $P(VIA671,U)=$$GET1^DIQ(67.1,IENS,.01,"I"),$P(VIA671,U,9)=$$GET1^DIQ(67.1,IENS,9,"I")
  1. . . S STR671="67.1:"_IENS_U_$P(VIA671,U)_U_$P(VIA671,U,9)_U_LRIEN
  1. . . D LAB6304
  1. K RESULT
  1. S RESULT=$NA(^TMP("VIABEFR",$J))
  1. Q
  1. ;
  1. IDS ; -- return lab results for list of identifiers
  1. N VIAID,I,X,Y
  1. ; parse identifiers into array
  1. F I=1:1:$L(VIAIDS,";") S Y=$P(VIAIDS,";",I) I Y'="" S VIAID(Y)=""
  1. S XREF="" F S XREF=$O(VIAID(XREF)) Q:XREF="" D:$D(^LRT(67.1,"C",XREF)) I QFLG Q
  1. . S IENS=0 F S IENS=$O(^LRT(67.1,"C",XREF,IENS)) Q:'IENS D I QFLG Q
  1. . . S LRIEN=$$GET1^DIQ(67.1,IENS,63,"I") I LRIEN="" Q
  1. . . S $P(VIA671,U)=$$GET1^DIQ(67.1,IENS,.01,"I"),$P(VIA671,U,9)=$$GET1^DIQ(67.1,IENS,9,"I")
  1. . . S STR671="67.1:"_IENS_U_$P(VIA671,U)_U_$P(VIA671,U,9)_U_LRIEN
  1. . . D LAB6304
  1. K RESULT
  1. S RESULT=$NA(^TMP("VIABEFR",$J))
  1. Q
  1. ;
  1. LAB6304 ; -- Using the LAB IEN from File #67.1, get data from LAB DATA File #63.04
  1. ; Builds ^TMP("VIABEFR",$J,n)=list of standard fields returned by the RPC. n is a numeric value.
  1. ; ^TMP("VIABEFR",$J,n+1)=63:04:IEN^.01 DATE/TIME SPECIMEN TAKEN^.06 ACCESSION^.03 DATE REPORT COMPLETED
  1. ; ^TMP("VIABEFR",$J,n+2)=4 CREATININE
  1. ; ^TMP("VIABEFR",$J,n+3)=31 COPPER
  1. ; ^TMP("VIABEFR",$J,n+4)=32 ZINC
  1. ; ^TMP("VIABEFR",$J,n+5)=33 ARSENIC
  1. ; ^TMP("VIABEFR",$J,n+6)=35 LEAD (SK)
  1. ; ^TMP("VIABEFR",$J,n+7)=101 CADMIUM
  1. ; ^TMP("VIABEFR",$J,n+8)=106 CHROMIUM
  1. ; ^TMP("VIABEFR",$J,n+9)=108 COBALT
  1. ; ^TMP("VIABEFR",$J,n+10)=116 MANGANESE (SK)
  1. ; ^TMP("VIABEFR",$J,n+11)=205 ALUMINUM
  1. ; ^TMP("VIABEFR",$J,n+12)=322 NICKEL (SK)
  1. ; ^TMP("VIABEFR",$J,n+13)=750 IRON
  1. ; ^TMP("VIABEFR",$J,n+14)=797 VOLUME
  1. ; ^TMP("VIABEFR",$J,n+15)=840 ELAPSED TIME
  1. ; VIAEFLDS - custom fields passed in as input parameter and returned by the RPC are stored after the standard fields.
  1. ; ^TMP("VIABEFR",$J,n+16)=TESTNAME;NUMBER^RESULT
  1. ;
  1. N X,VIAEFLDS,VIASFLDS,VIASFLDS1,VIASTR,IVDT,J,FLD,F671,VIAVAL
  1. S VIASFLDS=".01;.06;.03",VIASFLDS1="4;31;32;33;35;101;106;108;116;205;322;750;797;840",F671=1
  1. S VIAEFLDS=VIAFIELDS,IVDT=$S(VIABFRM'="":$P($P(VIABFRM,"^",2),",",2),1:VIASDT)
  1. F S IVDT=$O(^LR(LRIEN,"CH",IVDT)) Q:'IVDT Q:(IVDT>VIAEDT) D I VIACNT>VIAMAX S QFLG=1 D SETFRM Q
  1. . I F671 S VIAC=VIAC+1,^TMP("VIABEFR",$J,VIAC)=STR671,VIACNT=VIACNT+1,F671=0
  1. . S VIAVAL="",VIACNT=VIACNT+1
  1. . F J=1:1:$L(VIASFLDS,";") S FLD=$P(VIASFLDS,";",J) I FLD'="" D
  1. . . S VIASTR=$$GET1^DIQ(63.04,IVDT_","_LRIEN_",",FLD,"I")
  1. . . S VIAVAL=VIAVAL_$S(VIAVAL="":"",1:"^")_VIASTR
  1. . S VIAC=VIAC+1,^TMP("VIABEFR",$J,VIAC)="63.04:"_IVDT_"^"_VIAVAL
  1. . ; get data for remaining standard fields; get entire node since these are stored in non-standard FileMan format.
  1. . F J=1:1:$L(VIASFLDS1,";") S FLD=$P(VIASFLDS1,";",J) I FLD'="" D STMP
  1. . ; get data for additional fields passed in input parameter
  1. . F J=1:1:$L(VIAEFLDS,";") S FLD=$P(VIAEFLDS,";",J) I FLD'="" D STMP
  1. Q
  1. ;
  1. STMP ;set ^TMP("VIAEFR"
  1. N FLDNM,VIASTR
  1. D FIELD^DID(63.04,FLD,,"LABEL","VIALB") S FLDNM=$$UP^XLFSTR($G(VIALB("LABEL")))
  1. S VIASTR=$G(^LR(LRIEN,"CH",IVDT,FLD))
  1. I VIASTR'="" S VIAC=VIAC+1,^TMP("VIABEFR",$J,VIAC)=FLDNM_";"_FLD_"^"_VIASTR
  1. K VIALB
  1. Q
  1. ;
  1. STRTFRM() ; find where to start File 67.1 search
  1. N STR
  1. S STR=$P($P(VIAFROM,U),",")
  1. I $D(^LRT(67.1,"B",STR)) S VIAFROM=$O(^LRT(67.1,"B",STR),-1) Q VIAFROM
  1. S STR=$G(^LRT(67.1,+$P($P(VIAFROM,U),",",2),0)) I STR'="" S VIAFROM=$O(^LRT(67.1,"B",STR),-1) Q VIAFROM
  1. Q ""
  1. ;
  1. SETFRM ; entry to start list.
  1. S VIAC=VIAC+1,^TMP("VIABEFR",$J,VIAC)="[Misc]"
  1. S VIAC=VIAC+1,^TMP("VIABEFR",$J,VIAC)="MORE"_U_$P(VIA671,U)_","_IENS_U_LRIEN_","_$G(IVDT)
  1. Q
  1. ;
  1. DTCHK ;check/set date
  1. I $G(VIAEDT)<$G(VIASDT) S X=$G(VIAEDT),VIAEDT=$G(VIASDT),VIASDT=X
  1. I $G(VIAEDT) S VIAEDT=$S($L(VIAEDT,".")=2:VIAEDT+.000001,1:VIAEDT+1)
  1. S VIASDT=$S($G(VIASDT):9999999-VIASDT,1:9999999),VIAEDT=$S($G(VIAEDT):9999999-VIAEDT,1:1)
  1. S X=VIAEDT,VIAEDT=VIASDT,VIASDT=X
  1. Q
  1. ;
  1. KVAR ;Clean-up
  1. K VIAFIELDS,VIAEDT,VIAMAX,VIASDT,VIAFROM,VIABFRM,VIAIDS,X,Y
  1. Q
  1. ;