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

VBECRPCB.m

Go to the documentation of this file. 
  1. VBECRPCB ;HOIFO/BNT - ORDER LOOKUP BY UID ;03/24/2004
  1.  ;;2.0;VBECS;;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 CHECKUID^LRWU4 supported by IA #4636
  1.  ; Reference to LABORATORY TEST file 60 supported by IA #10054
  1.  ; Reference to LAB ORDER ENTRY file 69 supported by IA #4774
  1.  ; Reference to ACCESSION file 68 supported by IA #4773
  1.  ; Reference to PATIENT file 2 supported by IA #10035
  1.  ; Reference to $$FMTHL7^XLFDT supported by IA #10103
  1.  ;
  1.  QUIT
  1.  ;
  1.  ; -----------------------------------------------------------------------
  1.  ;     Private Method supports IA #4633
  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 VB68=$$CHECKUID^LRWU4(VBUID)
  1.  I '+VB68!('$L($P(VB68,"^",2))) D  Q
  1.  . D ERROR^VBECRPC("No accession associated with UID '"_VBUID_"'")
  1.  . D ENDROOT^VBECRPC("UIDLookup")
  1.  ;
  1.  I $P($G(^LRO(68,$P(VB68,"^",2),0)),"^",2)'="BB" D  Q
  1.  . D ERROR^VBECRPC("No Blood Bank accession area associated with UID '"_VBUID_"'")
  1.  . D ENDROOT^VBECRPC("UIDLookup")
  1.  ;
  1.  S VBACC=$P(VB68,"^",2)
  1.  S VBA=$P(VB68,"^",3)
  1.  S VBB=$P(VB68,"^",4)
  1.  ;
  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.  ;Add Collection Date/Time
  1.  S VBCOLDT=$P($G(^LRO(68,VBACC,1,VBA,1,VBB,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 collection date/time
  1.  D ADD^VBECRPC("<CollectionDateTime>"_$$CHARCHK^XOBVLIB($$FMTHL7^XLFDT(VBCOLDT))_"</CollectionDateTime>")
  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
  1.  ;
  1.  ; -----------------------------------------------------------------------
  1.  ;     Private Method supports IA #4614
  1.  ; -----------------------------------------------------------------------
  1. ORDNUM(RESULTS,LROIEN) ;
  1.  ;
  1.  N TEST,QUIT,VBA,VBB
  1.  S (VBECCNT,QUIT)=0
  1.  S RESULTS=$NA(^TMP("VBECS_ORDLOOKUP",$J))
  1.  K @RESULTS
  1.  D BEGROOT^VBECRPC("UIDLookup")
  1.  I LROIEN']"" D  Q
  1.  . D ERROR^VBECRPC("No Lab Order Number provided")
  1.  . D ENDROOT^VBECRPC("UIDLookup")
  1.  ;
  1.  I '$D(^LRO(69,"C",LROIEN)) D  Q
  1.  . D ERROR^VBECRPC("Lab Order Number "_LROIEN_" not found in file 69")
  1.  . D ENDROOT^VBECRPC("UIDLookup")
  1.  S VBA=0 F  S VBA=$O(^LRO(69,"C",LROIEN,VBA)) Q:'VBA  D  Q:QUIT
  1.  . S VBB=0 F  S VBB=$O(^LRO(69,"C",LROIEN,VBA,VBB)) Q:'VBB  D
  1.  . . i $p($g(^LRO(69,VBA,1,VBB,1)),"^",4)'="C" s QUIT=1 q  ;Collection status
  1.  . . ; Order has been merged.
  1.  . . IF $P($G(^LRO(69,VBA,1,VBB,1)),"^",7)]"" S QUIT=1 Q
  1.  . . D BEGROOT^VBECRPC("LabTests")
  1.  . . S VBC=0 F  S VBC=$O(^LRO(69,VBA,1,VBB,2,VBC)) Q:'VBC  D
  1.  . . . D BEGROOT^VBECRPC("LabTest")
  1.  . . . S VBLR0=^LRO(69,VBA,1,VBB,2,VBC,0)
  1.  . . . S LRDFN=$P(^LRO(69,VBA,1,VBB,0),"^",1),DFN=$P($G(^LR(LRDFN,0)),"^",3)
  1.  . . . S VBNAME=$$GET1^DIQ(2,DFN,.01)
  1.  . . . S VBTEST=$P($G(VBLR0),"^")
  1.  . . . S VBTNM=$$GET1^DIQ(60,VBTEST,.01)
  1.  . . . I $P($G(^LRO(69,VBA,1,VBB,2,VBC,0)),"^",3)']"" D  Q
  1.  . . . . S QUIT=1
  1.  . . . . D ERROR^VBECRPC("Lab Test "_VBTNM_" on order number "_LROIEN_" has not been accessioned")
  1.  . . . . D ENDROOT^VBECRPC("LabTest")
  1.  . . . S VBUID=$G(^LRO(69,VBA,1,VBB,2,VBC,.3))
  1.  . . . S VBCOLDT=$P($G(^LRO(68,$P($G(VBLR0),"^",4),1,$P($G(VBLR0),"^",3),1,$P($G(VBLR0),"^",5),3)),"^")
  1.  . . . S VBACCN=$G(^LRO(68,$P($G(VBLR0),"^",4),1,$P($G(VBLR0),"^",3),1,$P($G(VBLR0),"^",5),.2))
  1.  . . .;Add DFN and Name
  1.  . . . D ADD^VBECRPC("<PatientName>"_$$CHARCHK^XOBVLIB(VBNAME)_"</PatientName>")
  1.  . . . D ADD^VBECRPC("<VistaPatientId>"_$$CHARCHK^XOBVLIB(DFN)_"</VistaPatientId>")
  1.  . . . D ADD^VBECRPC("<LabOrderNumber>"_$$CHARCHK^XOBVLIB(LROIEN)_"</LabOrderNumber>")
  1.  . . . D ADD^VBECRPC("<LabTestID>"_$$CHARCHK^XOBVLIB(VBTEST)_"</LabTestID>")
  1.  . . . D ADD^VBECRPC("<LabTestName>"_$$CHARCHK^XOBVLIB(VBTNM)_"</LabTestName>")
  1.  . . . D ADD^VBECRPC("<SpecimenAccessionNumber>"_$$CHARCHK^XOBVLIB(VBACCN)_"</SpecimenAccessionNumber>")
  1.  . . . D ADD^VBECRPC("<SpecimenUID>"_$$CHARCHK^XOBVLIB(VBUID)_"</SpecimenUID>")
  1.  . . . ;Add collection date/time
  1.  . . . D ADD^VBECRPC("<CollectionDateTime>"_$$CHARCHK^XOBVLIB($$FMTHL7^XLFDT(VBCOLDT))_"</CollectionDateTime>")
  1.  . . . D ENDROOT^VBECRPC("LabTest")
  1.  . . . Q
  1.  . . D ENDROOT^VBECRPC("LabTests")
  1.  . . Q
  1.  . Q
  1.  D ENDROOT^VBECRPC("UIDLookup")
  1.  K DFN,LRDFN,VBA,VBACC,VBB,VBECCNT,VBNAME,VBORDN,VBTEST,VBTNM,VBUID,VBUID68,VBACCN
  1.  Q