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

VBECA1.m

Go to the documentation of this file.
  1. VBECA1 ;DALOI/PWC - APIS TO RETURN BLOOD BANK DATA FOR LAB ;10/12/00 13:57
  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 ^%DT supported by IA #10003
  1. ; Reference to GETS^DIQ() supported by IA #2056
  1. ;
  1. QUIT
  1. ; ----------------------------------------------------------------
  1. ; Private Method Supports IA 3181
  1. ; ----------------------------------------------------------------
  1. ABORH(PATID,PATNAM,PATDOB,PARENT) ;
  1. ; Return the ABO/Rh value for the DFN of the patient provided.
  1. ; A space will be between the values.
  1. ;
  1. ; Implement new VBECS API.
  1. N IFN
  1. D PAT^VBECA1A ;pass DFN, return LRDFN or 0 if not found
  1. I '$G(IFN) Q -1
  1. S ABORH=""
  1. Q $$ABORH^VBECA1B(IFN,"ABORH")
  1. ;
  1. ;K LRERR,DIERR,ARR
  1. ;D GETS^DIQ(63,LRDFN_",",".05;.06","E","ARR","LRERR")
  1. ;S P5=ARR(63,LRDFN_",",.05,"E"),P6=ARR(63,LRDFN_",",.06,"E")
  1. ;S ANS=P5_" "_P6
  1. ;K ARR
  1. ;Q ANS
  1. ;
  1. ; ----------------------------------------------------------------
  1. ; Private Method Supports IA 3181
  1. ; ----------------------------------------------------------------
  1. ABO(PATID,PATNAM,PATDOB,PARENT) ;
  1. ; Return the ABO value for the DFN of the patient provided.
  1. ;
  1. ; Implement new VBECS API.
  1. N IFN
  1. D PAT^VBECA1A ;pass DFN, return LRDFN or 0 if not found
  1. I '$G(IFN) Q -1
  1. S ABO=""
  1. Q $$ABORH^VBECA1B(IFN,"ABO")
  1. ;
  1. ;K LRERR,DIERR,ARR
  1. ;D GETS^DIQ(63,LRDFN_",",".05","E","ARR","LRERR")
  1. ;S P5=ARR(63,LRDFN_",",.05,"E"),ANS=P5
  1. ;K ARR
  1. ;Q ANS
  1. ;
  1. ; ----------------------------------------------------------------
  1. ; Private Method Supports IA 3181
  1. ; ----------------------------------------------------------------
  1. RH(PATID,PATNAM,PATDOB,PARENT) ;
  1. ; Return the Rh value for the DFN of the patient provided.
  1. ;
  1. ; Implement new VBECS API.
  1. N IFN
  1. D PAT^VBECA1A ;pass DFN, return LRDFN or 0 if not found
  1. I '$G(IFN) Q -1
  1. S RH=""
  1. Q $$ABORH^VBECA1B(IFN,"RH")
  1. ;
  1. ;K LRERR,DIERR,ARR
  1. ;D GETS^DIQ(63,LRDFN_",",".06","E","ARR","LRERR")
  1. ;S P6=ARR(63,LRDFN_",",.06,"E"),ANS=P6
  1. ;K ARR
  1. ;Q ANS
  1. ;
  1. ; -------------------------------------------------------
  1. ; Deprecated Method - Removed from IA 3181
  1. ; -------------------------------------------------------
  1. AGPRES(PATID,PATNAM,PATDOB,PARENT,ARR) ; Get Antigens Present
  1. ; Return an array of identified antigens and antigen comments for
  1. ; the DFN of the patient provided. If no antigens found, an empty
  1. ; array is returned ARR("AGPRES")="".
  1. ;
  1. ; ARR = the name of the array used to store antigens.
  1. ; Array will contain the name of the antigen and any antigen comments
  1. ; ARR("AGPRES",n) = Antigen ^ Antigen comment
  1. ;
  1. ;K ARR
  1. ;N LRDFN,A,I,X,P1,P2,P1A
  1. ;D PAT^VBECA1A ;pass DFN, return LRDFN or 0 if not found
  1. ;I 'LRDFN S ARR=-1 Q
  1. ;S A=0 F I=1:1 S A=$O(^LR(LRDFN,1,A)) Q:A="B"!(A="") D
  1. ;. S DATA=$G(^LR(LRDFN,1,A,0))
  1. ;. S P1=$P(DATA,"^",1),P2=$P(DATA,"^",2)
  1. ;. S P1A=$P($G(^LAB(61.3,P1,0)),"^",1)
  1. ;. S ARR("AGPRES",I)=P1A_"^"_P2
  1. ;S:'$D(ARR) ARR("AGPRES")="" ;return empty array if none found
  1. Q
  1. ;
  1. ; ----------------------------------------------------------------
  1. ; Private Method Supports IA 3181
  1. ; ----------------------------------------------------------------
  1. ABID(PATID,PATNAM,PATDOB,PARENT,ARR) ; Get Antibodies Identified
  1. ; Return an array of identified antibodies and antibody comments for
  1. ; the DFN of the patient provided.
  1. ;
  1. ; ARR = the name of the array used to store antibodies.
  1. ; Array will contain the name of the antibody and any antibody comments
  1. ; ARR("ABID",n) = Antibody ^ Antibody comment
  1. ;
  1. K ARR
  1. N IFN
  1. D PAT^VBECA1A ;pass DFN, return LRDFN or 0 if not found
  1. I '$G(IFN) S ARR=-1 Q
  1. D ABID^VBECA1B(IFN) Q
  1. ;
  1. ;S A=0 F I=1:1 S A=$O(^LR(LRDFN,1.7,A)) Q:A="" D
  1. ;. S DATA=$G(^LR(LRDFN,1.7,A,0))
  1. ;. S P1=$P(DATA,"^",1),P2=$P(DATA,"^",2)
  1. ;. S P1A=$P($G(^LAB(61.3,P1,0)),"^",1)
  1. ;. S ARR("ABID",I)=P1A_"^"_P2
  1. ;S:'$D(ARR) ARR("ABID")="" ;return empty array if none found
  1. ;Q
  1. ;
  1. ; -------------------------------------------------------
  1. ; Deprecated Method - Removed from IA 3181
  1. ; -------------------------------------------------------
  1. AGAB(PATID,PATNAM,PATDOB,PARENT,ARR) ; Get RBC Antigens Absent
  1. ; Return an array of absent antigens and absent antigen comments for
  1. ; the DFN of the patient provided.
  1. ; ARR = the name of the array used to store absent antigens.
  1. ; Array will contain the name of the antigen and any antigen comments
  1. ; ARR("AGAB",n) = Absent Antigen ^ Absent Antigen comment
  1. ;
  1. ;K ARR
  1. ;N LRDFN,A,I,X,P1,P2,P1A,DATA
  1. ;D PAT^VBECA1A ;pass DFN, return LRDFN or 0 if not found
  1. ;I 'LRDFN S ARR=-1 Q
  1. ;S A=0 F I=1:1 S A=$O(^LR(LRDFN,1.5,A)) Q:A="" D
  1. ;. S DATA=$G(^LR(LRDFN,1.5,A,0))
  1. ;. S P1=$P(DATA,"^",1),P2=$P(DATA,"^",2)
  1. ;. S P1A=$P($G(^LAB(61.3,P1,0)),"^",1)
  1. ;. S ARR("AGAB",I)=P1A_"^"_P2
  1. ;S:'$D(ARR) ARR("AGAB")="" ;return empty array if none found
  1. Q
  1. ;
  1. ; ----------------------------------------------------------------
  1. ; Private Method Supports IA 3181
  1. ; ----------------------------------------------------------------
  1. TRRX(PATID,PATNAM,PATDOB,PARENT,ARR) ; Get Transfusion Reactions
  1. ; Return an array of transfusion reactions for the DFN of the
  1. ; patient provided. If no transfusion reactions found, an
  1. ; empty array is returned ARR("TRRX")=""
  1. ;
  1. ; ARR = the name of the array used to store transfusion reactions.
  1. ; Array will contain both reactions where a particular unit or
  1. ; transfusion was determined to be the cause of the reaction, and
  1. ; those where no unit could be identified as being the cause of the
  1. ; reaction.
  1. ; Transaction Type is a pointer to Blood Bank Utility File #65.4
  1. ; ARR("TRRX",n) = Transfusion Date/Time ^ Transaction Type
  1. ;
  1. ; Implement new VBECS API.
  1. K ARR
  1. N IFN
  1. D PAT^VBECA1A ;pass DFN, return LRDFN or 0 if not found
  1. I '$G(IFN) S ARR=-1 Q
  1. D TRRX^VBECA1B(IFN) Q
  1. ;
  1. ; get the reactions associated with a particular transfusion
  1. ;S (A,CNT)=0 F S A=$O(^LR(LRDFN,1.6,A)) Q:A="" D
  1. ;. S DATA=$G(^LR(LRDFN,1.6,A,0))
  1. ;. S P1=$P(DATA,"^",1),P11=$P(DATA,"^",11) Q:P11="" ;transaction type
  1. ;. S P11A=$S(P11'="":$P($G(^LAB(65.4,P11,0)),"^",1),1:"")
  1. ;. S CNT=CNT+1,ARR("TRRX",CNT)=P1_"^"_P11A D
  1. ;. . D FIND^DIC(66,,".02","A","`"_$P(DATA,"^",2),,,,,"VBECTRX")
  1. ;. . S ARR("TRRX",CNT)=ARR("TRRX",CNT)_"^"_VBECTRX("DILIST","ID",1,.02)_"^"_$P(DATA,"^",3) ;Added UNIT ID and COMPONENT
  1. ;. . S CMT=0 F S CMT=$O(^LR(LRDFN,1.6,A,1,CMT)) Q:'CMT S ARR("TRRX",CNT,CMT)=^LR(LRDFN,1.6,A,1,CMT,0)
  1. ;; now get the reactions NOT associated with a particular transfusion
  1. ;S A=0 F S A=$O(^LR(LRDFN,1.9,A)) Q:A="" D
  1. ;. S DATA=$G(^LR(LRDFN,1.9,A,0))
  1. ;. S P1=$P(DATA,"^",1),P2=$P(DATA,"^",2) Q:P2="" ;transaction type
  1. ;. S P2A=$S(P2'="":$P($G(^LAB(65.4,P2,0)),"^",1),1:"")
  1. ;. S CNT=CNT+1,ARR("TRRX",CNT)=P1_"^"_P2A
  1. ;. S CMT=0 F S CMT=$O(^LR(LRDFN,1.9,A,1,CMT)) Q:'CMT S ARR("TRRX",CNT,CMT)=^LR(LRDFN,1.9,A,1,CMT,0)
  1. ;S:'$D(ARR) ARR("TRRX")="" ;return empty array if none found
  1. Q
  1. ;
  1. ; -------------------------------------------------------
  1. ; Private Method supports IA 3181-H
  1. ; -------------------------------------------------------
  1. BBCMT(PATID,PATNAM,PATDOB,PARENT,ARR) ; Get Blood Bank Comments
  1. ; Return an array of blood bank comments for the DFN of the patient
  1. ; provided.
  1. ; If no comments found, an empty array is returned ARR("BBCMT")="".
  1. ; ARR = the name of the array that will be used to store comments.
  1. ; Array will contain all the comment text.
  1. ; ARR("BBCMT",n) = Blood Bank Comment Text
  1. ;
  1. K ARR
  1. N LRDFN,A,I,P76
  1. D PAT^VBECA1A ;pass DFN, return LRDFN or 0 if not found
  1. I 'LRDFN S ARR=-1 Q
  1. S A=0 F I=1:1 S A=$O(^LR(LRDFN,3,A)) Q:A="" D
  1. . S P76=$G(^LR(LRDFN,3,A,0))
  1. . S ARR("BBCMT",I)=P76
  1. S:'$D(ARR) ARR("BBCMT")="" ;return empty array if none found
  1. Q
  1. ;
  1. ; -------------------------------------------------------
  1. ; Deprecated Method - Removed from IA 3181
  1. ; -------------------------------------------------------
  1. AUTO(PATID,PATNAM,PATDOB,PARENT,ARR) ; Get Available Autologous Units
  1. ; Return an array of available autologous units for the DFN of the
  1. ; patient provided. If no comments found, an empty array is returned
  1. ; ARR("AUTO")="".
  1. ;
  1. ; ARR = the name of the array that will store autologous units.
  1. ; Array will contain the component type and the expiration date.
  1. ; ARR("AUTO",n) = Component Type ^ Expiration Date
  1. ; Component Type is a pointer to Blood Product File (#66)
  1. ;
  1. ;K ARR
  1. ;N LRDFN,A,I,AU,AUT,CMP,COMP,CNT,DATA,EXPDT,EXP
  1. ;D PAT^VBECA1A ;pass DFN, return LRDFN or 0 if not found
  1. ;I 'LRDFN S ARR=-1 Q
  1. ;I '$D(^LRD(65,"AU",LRDFN)) S ARR("AUTO")="" Q ;no AP xref
  1. ;S (A,CNT)=0 F I=1:1 S A=$O(^LRD(65,"AU",LRDFN,A)) Q:A="" D
  1. ;. S AUT=$G(^LRD(65,A,4)) Q:$P(AUT,"^")'="" ; already dispositioned
  1. ;. S AU=$P(^LRD(65,A,8),"^",3) Q:AU'="A" ; autologous unit
  1. ;. S DATA=$G(^LRD(65,A,0)),CMP=$P(DATA,"^",4),EXPDT=$P(DATA,"^",6)
  1. ;. S COMP=$P($G(^LAB(66,CMP,0)),"^",1) ; ptr to blood product file
  1. ;. D EXPIRE(EXPDT) Q:EXP=1 ;unit is expired
  1. ;. S CNT=CNT+1,ARR("AUTO",CNT)=COMP_"^"_EXPDT
  1. ;S:'$D(ARR) ARR("AUTO")="" ;return empty array if none found
  1. Q
  1. ;
  1. EXPIRE(X) ; check if date has expired
  1. S EXP=0,%DT="TXF" D ^%DT S X=Y K:Y<1 X
  1. I $D(X) S X(1)=X,%DT="T",X="N" D ^%DT S X=X(1) D
  1. . I $P(X,".")'>$P(Y,".") S EXP=1 Q ; Unit expired or expires today
  1. . S EXP=0
  1. Q