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

VBECA3.m

Go to the documentation of this file.
  1. VBECA3 ;HINES IFO/DDA-API interfaces for CPRS ;9/20/00 12:44
  1. ;;2.0;VBEC;;Jun 05, 2015;Build 4
  1. ;
  1. ; Note: This routine supports data exchange with an FDA registered
  1. ; medical device. As such, it may not be changed in any way without
  1. ; prior written approval from the medical device manufacturer.
  1. ;
  1. ; Integration Agreements:
  1. ; Reference DBIA 4619 - VBECS Order Entry
  1. ; Reference to GETS^DIQ() supported by IA #2056
  1. ; Reference to $$LRDFN^LR7OR1 supported by IA #2503
  1. ; Reference to EN^LR7OSBR supported by IA #3190-A
  1. ; Reference to EN1^LR7OSBR supported by IA #3190-B
  1. ; Reference to $$CHARCHK^XOBVLIB supported by IA #4090
  1. ;
  1. QUIT
  1. ;
  1. EN(LRDFN) ; Call to encapsulate the extract of Blood Bank data for CPRS
  1. ; via the call EN^LR7OSBR. This call can be tested by invoking the
  1. ; routine BLR^ORWRP1(root,dfn), where root is the null string and
  1. ; DFN is the PATIENT FILE numeric internal entry number for the
  1. ; patient.
  1. ; Parameter LRDFN is the LAB numeric internal entry number for the
  1. ; LAB patient.
  1. N X
  1. S X="LR7OSBR" X ^%ZOSF("TEST") I '$T W !,"LR7OSBR does not exist in this environment." Q
  1. D EN^LR7OSBR
  1. Q
  1. ;
  1. EN1(DFN) ; Call to encapsulate the extract of Blood Bank data for CPRS
  1. ; via the call EN1^LR7OSBR.
  1. ; Parameter DFN is the PATIENT FILE numeric internal entry number for
  1. ; the LAB patient.
  1. N X
  1. S X="LR7OSBR" X ^%ZOSF("TEST") I '$T W !,"LR7OSBR does not exist in this environment." Q
  1. D EN1^LR7OSBR(DFN)
  1. Q
  1. ;
  1. ; ------------------------------------------------------
  1. ; Private method supports IA #4766
  1. ; ------------------------------------------------------
  1. OEAPI(ARR,DFN,DIV) ; CPRS query to return patient and component related
  1. ; data from VBECS through VistALink
  1. IF DFN']"" SET ARR("ERROR")="1^No Patient ID Provided" QUIT
  1. IF '$D(^DPT(DFN,0)) SET ARR("ERROR")="1^Undefined VistA Patient ID" QUIT
  1. IF DIV']"" SET ARR("ERROR")="1^No Patient Division Provided" QUIT
  1. ;
  1. NEW VBECY,VBECSTAT
  1. SET ARR("ERROR")=0
  1. DO INITV^VBECRPCC("VBECS Order Entry")
  1. IF +VBECPRMS("ERROR") S ARR("ERROR")=VBECPRMS("ERROR") Q
  1. SET VBECPRMS("PARAMS",1,"TYPE")="STRING"
  1. SET VBECPRMS("PARAMS",1,"VALUE")=$$CHARCHK^XOBVLIB(DFN)
  1. SET VBECPRMS("PARAMS",2,"TYPE")="STRING"
  1. SET VBECPRMS("PARAMS",2,"VALUE")=$$CHARCHK^XOBVLIB(DIV)
  1. ;
  1. SET VBECSTAT=$$EXECUTE^VBECRPCC(.VBECPRMS)
  1. ;
  1. SET VBECY=$NA(^TMP("VBECS_XML_RES",$J))
  1. KILL @VBECY
  1. DO PARSE^VBECRPC1(.VBECPRMS,VBECY)
  1. IF $D(@VBECY@("ERROR")) SET ARR("ERROR")="1^"_@VBECY@("ERROR") DO CLEANUP QUIT
  1. DO EN^VBECA3C(.ARR,VBECY)
  1. ; Setting for debugging GUI
  1. KILL ^XTMP("OEAPI")
  1. M ^XTMP("OEAPI",$J,$P(^DPT(DFN,0),U),DIV)=ARR
  1. M ^XTMP("OEAPI",$J,DFN,DIV)=^TMP("VBECS_XML_RES",$J)
  1. ;Q KILL @VBECY
  1. ;
  1. ;DO CLEANUP
  1. QUIT
  1. BBDATA(DFN) ;Retrieve data for CPRS reports
  1. ;File 63's somewhat unique storage method limits the usefulness
  1. ;of some of the Kernel database calls. It was necessary to determine
  1. ;the first subscript level in the BB node and call the Kernel
  1. ;API with this level predefined.
  1. ;All references (field name and values) are converted to the external
  1. ;format.
  1. ;Null values are not returned.
  1. ;Inverse date values are converted to normal format.
  1. K ^TMP("VBHOLD",$J),^TMP("VBDATA",$J)
  1. S LRDFN=$$LRDFN^LR7OR1(DFN)
  1. F VBAA=0 F S VBAA=$O(^LR(LRDFN,"BB",VBAA)) Q:'VBAA S VBAAA=VBAA_","_LRDFN_"," D
  1. . D GETS^DIQ(63.01,VBAAA,"**","ERN","^TMP(""VBHOLD"","_$J,"ERROR")
  1. S VBAA=0 F S VBAA=$O(^TMP("VBHOLD",$J,VBAA)) Q:VBAA="" D
  1. . S VBAB=0 F S VBAB=$O(^TMP("VBHOLD",$J,VBAA,VBAB)) Q:VBAB="" D
  1. . . S VBAC=0 F S VBAC=$O(^TMP("VBHOLD",$J,VBAA,VBAB,VBAC)) Q:VBAC="" D
  1. . . . I $L(VBAB,",")=3 S VBAD=$P(VBAB,",") I VBAD?7N1".".N S VBAD=9999999-VBAD
  1. . . . I $L(VBAB,",")=4 S VBAD=$P(VBAB,",",2) I VBAD?7N1".".N S VBAD=9999999-VBAD
  1. . . . S ^TMP("VBDATA",$J,VBAD,VBAC)=^TMP("VBHOLD",$J,VBAA,VBAB,VBAC,"E")
  1. D GETS^DIQ(63,LRDFN,".084*","ERN","VBCMPRQ","ERROR")
  1. S VBAA="" F S VBAA=$O(VBCMPRQ(63.084,VBAA)) Q:VBAA="" D
  1. . S VBAB="" F S VBAB=$O(VBCMPRQ(63.084,VBAA,VBAB)) Q:VBAB="" D
  1. . . S VBAC=$P(VBAA,",")
  1. . . S ^TMP("VBDATA",$J,"COMPONENT REQUEST",VBAC,VBAB)=VBCMPRQ(63.084,VBAA,VBAB,"E")
  1. K ^TMP("VBHOLD",$J),VBAA,VBAB,VBAC,VBAD,VBAAA,VBCMPRQ
  1. Q
  1. CLEANUP ;
  1. KILL VBECPRMS,VBECSTAT
  1. KILL ^TMP("VBECS_XML_RES",$J)
  1. QUIT