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

VBECA6.m

Go to the documentation of this file.
  1. VBECA6 ;DALOI/RLM - ORDER LOOKUP BY UID ;05/14/2003
  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 to $$FIND^DIC supported by IA #2051
  1. ; Reference to $$GET1^DIQ supported by IA #2052
  1. ; Reference to $$CHARCHK^XOBVLIB supported by IA #4090
  1. ; Reference to CHKNAME^XQ5 supported by IA #????
  1. ;
  1. ORDER(RESULTS,VBUID) ;
  1. ;Bring in UID and RESULTS parameters.
  1. ;UID will be the Universal Identifier for this order.
  1. ;RESULTS will be the array where the data will be stored.
  1. N TEST,ERROR
  1. S VBECCNT=0
  1. S RESULTS=$NA(^TMP("VBECS_UIDLOOKUP",$J))
  1. K @RESULTS
  1. D BEGROOT^VBECRPC("UIDLookup")
  1. I VBUID']"" D Q
  1. . D ERROR^VBECRPC("No Specimen UID provided")
  1. . D ENDROOT^VBECRPC("UIDLookup")
  1. ;
  1. D FIND^DIC(68,,.01,,"BLOOD BANK",,,,,"TEST","ERROR")
  1. S VBACC=TEST("DILIST",2,1)
  1. I '$D(^LRO(68,"C",VBUID,VBACC)) D Q
  1. . D ERROR^VBECRPC("No Blood Bank accession associated with UID '"_VBUID_"'")
  1. . D ENDROOT^VBECRPC("UIDLookup")
  1. ;
  1. S VBA=0 F S VBA=$O(^LRO(68,"C",VBUID,VBACC,VBA)) Q:'VBA D
  1. . S VBB=0 F S VBB=$O(^LRO(68,"C",VBUID,VBACC,VBA,VBB)) Q:'VBB D
  1. . . Q:$P($G(^LRO(68,VBACC,1,VBA,1,VBB,0)),"^",2)'=2 ;Add parameter for 67 if necessary
  1. . . S LRDFN=$P($G(^LRO(68,VBACC,1,VBA,1,VBB,0)),"^"),DFN=$P($G(^LR(LRDFN,0)),"^",3)
  1. . . S VBNAME=$$GET1^DIQ(2,DFN,.01)
  1. . . ;Add DFN and Name
  1. . . D ADD^VBECRPC("<PatientName>"_$$CHARCHK^XOBVLIB(VBNAME)_"</PatientName>")
  1. . . D ADD^VBECRPC("<VistaPatientId>"_$$CHARCHK^XOBVLIB(DFN)_"</VistaPatientId>")
  1. . . ;Add Accession number
  1. . . S VBACCN=$P($G(^LRO(68,VBACC,1,VBA,1,VBB,.2)),"^")
  1. . . D ADD^VBECRPC("<SpecimenAccessionNumber>"_$$CHARCHK^XOBVLIB(VBACCN)_"</SpecimenAccessionNumber>")
  1. . . S VBORDN=+$P($G(^LRO(68,VBACC,1,VBA,1,VBB,.1)),"^")
  1. . . ;Add Order Number
  1. . . D ADD^VBECRPC("<LabOrderNumber>"_$$CHARCHK^XOBVLIB(VBORDN)_"</LabOrderNumber>")
  1. . . ;Add UID from file 68
  1. . . S VBUID68=$P($G(^LRO(68,VBACC,1,VBA,1,VBB,.3)),"^")
  1. . . D ADD^VBECRPC("<SpecimenUID>"_$$CHARCHK^XOBVLIB(VBUID68)_"</SpecimenUID>")
  1. . . ;Add Tests
  1. . . D BEGROOT^VBECRPC("LabTests")
  1. . . S VBC=0 F S VBC=$O(^LRO(68,VBACC,1,VBA,1,VBB,4,VBC)) Q:'VBC D
  1. . . . S VBTEST=+$P($G(^LRO(68,VBACC,1,VBA,1,VBB,4,VBC,0)),"^")
  1. . . . S VBTNM=$$GET1^DIQ(60,VBTEST,.01)
  1. . . . ;Add Test Name
  1. . . . D BEGROOT^VBECRPC("LabTest")
  1. . . . D ADD^VBECRPC("<LabTestID>"_$$CHARCHK^XOBVLIB(VBTEST)_"</LabTestID>")
  1. . . . D ADD^VBECRPC("<LabTestName>"_$$CHARCHK^XOBVLIB(VBTNM)_"</LabTestName>")
  1. . . . D ENDROOT^VBECRPC("LabTest")
  1. . . ;Close Tests
  1. . . D ENDROOT^VBECRPC("LabTests")
  1. D ENDROOT^VBECRPC("UIDLookup")
  1. K DFN,LRDFN,TEST,VBA,VBACC,VBB,VBC,VBECCNT,VBNAME,VBORDN,VBTEST,VBTNM,VBUID,VBUID68,VBACCN
  1. Q