source: FOIAVistA/trunk/r/VBECS-VBEC/VBECA3A.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.8 KB
Line 
1VBECA3A ;DALOI/RLM-API interface for CPRS ;9/20/00 12:44
2 ;;0.5;VBECS;**294**;Sep 6, 2000
3 ; This routine retrieves data maintained by a regulated medical
4 ; device. The routine must not be modified by anyone other than the
5 ; device manufacturer.
6 ;Reference to $$LRDFN^LR7OR1 supported by IA #2503
7 ;Reference to GETS^DIQ() supported by IA #2056
8 Q
9DFN(DFN) ;Main entry point. Calls the SPECIMEN, COMPONENT REQUEST, and CROSSMATCH data
10 D EXIT K VBCMPRQ
11 K ^TMP("VBHOLD",$J),^TMP("VBDATA",$J)
12 S LRDFN=$$LRDFN^LR7OR1(DFN) Q:'LRDFN
13 D A,B,C
14 G EXIT
15A ;Retrieves SPECIMEN data
16 S VBAA=0 F S VBAA=$O(^LR(LRDFN,"BB",VBAA)) Q:'VBAA S VBAAA=VBAA_","_LRDFN_"," D
17 . D GETS^DIQ(63.01,VBAAA,".01;.03;.99*;2.1;2.4;2.6;2.9;2.91;3*;6;7*;8*;10;10.3;11;11.3","EN","^TMP(""VBHOLD"","_$J,"ERROR")
18 S VBAA=0 F S VBAA=$O(^TMP("VBHOLD",$J,VBAA)) Q:VBAA="" D
19 . S VBAB=0 F S VBAB=$O(^TMP("VBHOLD",$J,VBAA,VBAB)) Q:VBAB="" D
20 . . ;I $L(VBAB,",")=3,$G(^TMP("VBHOLD",$J,VBAA,VBAB,"DATE/TIME SPECIMEN TAKEN","E"))="" Q
21 . . I $L(VBAB,",")=3,$G(^TMP("VBHOLD",$J,VBAA,VBAB,.01,"E"))="" Q
22 . . S VBAC=0 F S VBAC=$O(^TMP("VBHOLD",$J,VBAA,VBAB,VBAC)) Q:VBAC="" D
23 . . . I $L(VBAB,",")=3 S VBAD=$P(VBAB,",") I VBAD?7N1".".N S VBAD=9999999-VBAD
24 . . . I $L(VBAB,",")=4 S VBAD=$P(VBAB,",",2) I VBAD?7N1".".N S VBAD=9999999-VBAD
25 . . . I $L(VBAB,",")=3 S ^TMP("VBDATA",$J,"SPECIMEN",VBAD,VBAA_","_VBAC)=^TMP("VBHOLD",$J,VBAA,VBAB,VBAC,"E")
26 . . . I $L(VBAB,",")=4 S ^TMP("VBDATA",$J,"SPECIMEN",VBAD,VBAA_","_VBAC,$P(VBAB,","))=^TMP("VBHOLD",$J,VBAA,VBAB,VBAC,"E")
27 Q
28B ;Retrieves COMPONENT REQUEST data
29 S VBAA=0,VBINT(.08)="" F S VBAA=$O(^LR(LRDFN,1.8,VBAA)) Q:'VBAA S VBAAA=VBAA_","_LRDFN_"," D
30 . D GETS^DIQ(63.084,VBAAA,".01;.04;.03;.05;.09;.08","IEN","VBCMPRQ","ERROR")
31 S VBAA="" F S VBAA=$O(VBCMPRQ(63.084,VBAA)) Q:VBAA="" D
32 . S VBAB="" F S VBAB=$O(VBCMPRQ(63.084,VBAA,VBAB)) Q:VBAB="" D
33 . . S VBAC=$P(VBAA,",")
34 . . S ^TMP("VBDATA",$J,"COMPONENT REQUEST",VBAC,VBAB)=VBCMPRQ(63.084,VBAA,VBAB,$S($D(VBINT(VBAB)):"I",1:"E"))
35 Q
36C ;Retrieves CROSSMATCH data
37 S VBAA=0 F S VBAA=$O(^LRD(65,"AP",LRDFN,VBAA)) Q:'VBAA D
38 . D GETS^DIQ(65,VBAA,".01;.04;.07;.08;.06;.16","EN","VBXMATCH","ERROR")
39 . S VBAC=$O(^LRD(65,+VBAA,3,0)) Q:'VBAC
40 . D GETS^DIQ(65.03,VBAC_","_+VBAA_",",.04,"EN","VBXMTCH1","ERROR")
41 S VBAA=0 F S VBAA=$O(VBXMATCH(65,VBAA)) Q:VBAA="" S VBAB=0 F S VBAB=$O(VBXMATCH(65,VBAA,VBAB)) Q:VBAB="" D
42 . S ^TMP("VBDATA",$J,"CROSSMATCH",+VBAA,VBAB)=VBXMATCH(65,VBAA,VBAB,"E")
43 S VBAA="" F S VBAA=$O(VBXMTCH1(65.03,VBAA)) Q:VBAA="" S VBAB="" F S VBAB=$O(VBXMTCH1(65.03,VBAA,VBAB)) Q:VBAB="" S ^TMP("VBDATA",$J,"CROSSMATCH",$P(VBAA,",",2),3)=$G(VBXMTCH1(65.03,VBAA,".04","E"))
44 Q
45EXIT ;Clean up a few variables
46 K LRDFN,VBAA,VBAB,VBAC,VBAD,VBAAA,VBCMPRQ,VBINT,VBXMATCH,VBXMTCH1
47 Q
48ZEOR ;VBECA3A
Note: See TracBrowser for help on using the repository browser.