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

ORWLR1.m

Go to the documentation of this file.
  1. ORWLR1 ; SLC/DCM - VBEC Blood Bank Report ;Dec 02, 2021@12:51:03
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**172,212,309,332,375,527,405**;Dec 17, 1997;Build 211
  1. ;Re-write of ^LR7OSBR
  1. ;DBIA 7203 ^VBECRPT
  1. EN(DFN) ;Get Blood Bank Report
  1. Q:'$G(DFN)
  1. D ^VBECRPT ;RLM
  1. Q
  1. N GCNT,CCNT,GIOSL,GIOM,ORABORH,PATID,PATNAM,PATDOB,ORN
  1. S PATID="`"_DFN,PATNAM=$P(^DPT(DFN,0),"^"),PATDOB=$P(^(0),"^",3) ;Why PATNAM and PATDOB???
  1. K ^TMP("ORLRC",$J)
  1. S GCNT=0,CCNT=1,GIOSL=999999,GIOM=80
  1. S ORABORH=$$ABORH^VBECA1(PATID,PATNAM,PATDOB) ;Get ABO/RH
  1. I $E(ORABORH,1,2)="1^" S ORX("ERROR")=ORABORH D Q ;Isolate error condition
  1. . N GCNT,CCNT,GIOSL,GIOM,I,TYPE,ORUA,VBERROR,ABFND,LINE1,LINE2,NOABO,NOPAT,TREQFND
  1. . S (GCNT,NOPAT,NOABO)=0,CCNT=1,GIOSL=999999,GIOM=80
  1. . ;S OROOT=$NA(^TMP("ORVBEC",$J)) ;p375 line removed because it is not needed and causing issues
  1. . D ERROR^ORWDXVB2("^TMP(""ORLRC"",$J)")
  1. S ORN(2.91)="DIRECT AHG TEST COMMENT",ORN(8)="ANTIBODY SCREEN COMMENT"
  1. S ORN(10.3)="ABO TESTING COMMENT",ORN(11.3)="RH TESTING COMMENT"
  1. D EN^ORWLR2
  1. Q
  1. REPORT ;Blood Bank Report for M reports menu
  1. Q:'$G(DFN)
  1. N DIC,ID,ORDFN,ORY,PAGE,XQORNOD,ORDAYSBK
  1. S ORDFN=DFN,ID=2
  1. D BLR^ORWRP1(.ORY,.ORDFN,.ID,.ORALPHA,.OROMEGA,.ORDAYSBK,.REMOTE)
  1. Q:'$L(ORY)
  1. S PAGE=1
  1. ;D HEAD^ORWRPP1(ORDFN,PAGE,"PATIENT BLOOD BANK REPORT",$G(STATION))
  1. ;D HURL^ORWRPP1(.ORY,ORDFN,"PATIENT BLOOD BANK REPORT",,,1)
  1. ;modified lab header to include facility address
  1. D LRHEAD^ORWRPP1(ORDFN,PAGE,"PATIENT BLOOD BANK REPORT",$G(STATION))
  1. D LRHURL^ORWRPP1(.ORY,ORDFN,"PATIENT BLOOD BANK REPORT",,,1)
  1. Q
  1. GETPAT(ERR) ;Setup Patient Variables
  1. N ORPNM
  1. S ERR=0
  1. D EN2^ORUDPA
  1. I 'ORVP S ERR=1 Q
  1. S PATID="`"_+ORVP,PATNAM=ORPNM,PATDOB=$P(^DPT(+ORVP,0),"^",3)
  1. D PAT^VBECA1A
  1. W !,LRDFN
  1. I $O(VBECERR(0)) D S ERR=1 Q
  1. . S ERR=0 F S ERR=$O(VBECERR(ERR)) Q:'ERR W !?5," ERR:"_VBECERR(1)
  1. Q
  1. TEST ;Test calls
  1. N ORVP,PATID,PATNAM,PATDOB,LRDFN,ERR,ABORH,ID,ID1,ID2,ARR,GMI,DI2,BPN,VBECERR,ERROR
  1. D GETPAT(.ERROR)
  1. I $G(ERROR) W !,"Error on Patient lookup" Q
  1. D ABORH,ABID,TRRX,DFN,CPRS,TRAN
  1. I $O(^TMP("VBDATA",$J,"CROSSMATCH",0)) D
  1. . W !,"Crossmatched Units: " S ID=0 F S ID=$O(^TMP("VBDATA",$J,"CROSSMATCH",ID)) Q:'ID W !?2,^(ID)
  1. K ^TMP("VBDATA",$J),^TMP("TRRX",$J),^TMP("TRAN",$J)
  1. Q
  1. OEAPI ;Test call to OEAPI^VBECA3
  1. N DIV,ORSTN,ERROR,ORVB
  1. D GETPAT^ORWLR1(.ERROR)
  1. I $G(ERROR) W !,"Error on Patient lookup" Q
  1. S DIV=+$P($G(^SC(+$G(ORL),0)),U,15),ORSTN=$P($$SITE^VASITE(DT,DIV),U,3)
  1. D OEAPI^VBECA3(.ORVB,+ORVP,ORSTN)
  1. I $O(ORVB(0)) D
  1. . W !,"Array returned from OEAPI^VBECA3 API in ORVB():",!
  1. . ;ZW ORVB
  1. K ^TMP("OR",$J),^TMP("VBECRPC",$J),^TMP("VBECS_XML_RES",$J),^TMP("VBEC_OE_DATA",$J)
  1. Q
  1. ABORH ;Test call to ABORH^VBECA1 for ABO/Rh - DBIA 3181
  1. N ERROR
  1. I '$G(ORVP) D GETPAT(.ERROR)
  1. I $G(ERROR) W !,"Error on Patient lookup" Q
  1. S ABORH=$$ABORH^VBECA1(PATID,PATNAM,PATDOB) W !,"ABO/RH: "_ABORH
  1. Q
  1. ABID ;Test call to ABID^VBECA1 for Antibodies Identified - DBIA 3181, 3184
  1. N ID,ERROR,ORPARNT
  1. I '$G(ORVP) D GETPAT(.ERROR)
  1. I $G(ERROR) W !,"Error on Patient lookup" Q
  1. D ABID^VBECA1(PATID,PATNAM,PATDOB,.ORPARNT,.ORARR) I $O(ARR("ABID",0)) D
  1. . W !,"Antibodies Identified: " S ID=0 F S ID=$O(ARR("ABID",ID)) Q:'ID W !?2,ARR("ABID",ID)
  1. Q
  1. DFN ;Test call to DFN^VBECA3A - DBIA 3879
  1. N ID,ID1,ID2,ERROR
  1. K ^TMP("VBDATA",$J)
  1. I '$G(ORVP) D GETPAT(.ERROR)
  1. I $G(ERROR) W !,"Error on Patient lookup" Q
  1. D DFN^VBECA3A(DFN)
  1. I $O(^TMP("VBDATA",$J,"COMPONENT REQUEST",0)) D
  1. . W !,"Component request: " S ID=0 F S ID=$O(^TMP("VBDATA",$J,"COMPONENT REQUEST",ID)) Q:'ID W !?2,^(ID) D
  1. .. S ID1=0 F S ID1=$O(^TMP("VBDATA",$J,"COMPONENT REQUEST",ID,ID1)) Q:'ID1 W !,"."_^(ID1)
  1. I $O(^TMP("VBDATA",$J,"SPECIMEN",0)) D
  1. . W !,"Specimen: " S ID=0 F S ID=$O(^TMP("VBDATA",$J,"SPECIMEN",ID)) Q:'ID W !?2,^(ID) D
  1. .. S ID1=0 F S ID1=$O(^TMP("VBDATA",$J,"SPECIMEN",ID,ID1)) Q:'ID1 W:$D(^(ID1))#2 !,"."_^(ID1) D
  1. ... S ID2=0 F S ID2=$O(^TMP("VBDATA",$J,"SPECIMEN",ID,ID1,ID2)) Q:'ID2 W:$D(^(ID2))#2 !,".."_^(ID2)
  1. I $O(^TMP("VBDATA",$J,"UNIT",0)) D
  1. . W !,"Available Units: "
  1. . S ID=0 F S ID=$O(^TMP("VBDATA",$J,"UNIT",ID)) Q:'ID W !?2,^(ID)
  1. Q
  1. CPRS ;Test call to CPRS^VBECA3B - DBIA 3880
  1. N ID,ID1,ID2,ERROR
  1. K ^TMP("BBD",$J)
  1. I '$G(ORVP) D GETPAT(.ERROR)
  1. I $G(ERROR) W !,"Error on Patient lookup" Q
  1. D CPRS^VBECA3B
  1. I $O(^TMP("BBD",$J,"SPECIMEN",0)) D
  1. . W !,"Specimen: " S ID=0 F S ID=$O(^TMP("BBD",$J,"SPECIMEN",ID)) Q:'ID W !?2,^(ID) D
  1. .. S ID1=0 F S ID1=$O(^TMP("BBD",$J,"SPECIMEN",ID,ID1)) Q:'ID1 W:$D(^(ID1))#2 !,"."_^(ID1) D
  1. ... S ID2=0 F S ID2=$O(^TMP("BBD",$J,"SPECIMEN",ID,ID1,ID2)) Q:'ID2 W:$D(^(ID2))#2 !,".."_^(ID2)
  1. Q
  1. TRAN ;Test call to TRAN^VBECA4 for Tranfused Units - DBIA 3176
  1. N BPN,ID,GMI,GMR,ERROR,CNT,ORAY,COMP,COMPSEQ,X,TD
  1. K ^TMP("TRAN",$J),^TMP("ZTRAN",$J)
  1. I '$G(ORVP) D GETPAT(.ERROR)
  1. I $G(ERROR) W !,"Error on Patient lookup" Q
  1. D TRAN^VBECA4(+ORVP,"TRAN")
  1. ;^TMP("TRAN",$J,InverseDate)="Date^Number of Units\Product Type"
  1. ;^TMP("TRAN",$J,"Product Type")="Product Type Print Name"
  1. S CNT=0 F ID="RBC","FFP","PLT","CRY","PLA","SER","GRA","WB" S CNT=CNT+1,ORAY(ID)=CNT
  1. S ID=0 F S ID=$O(^TMP("TRAN",$J,ID)) Q:'ID S GMR=^(ID),COMP=$P(GMR,"^",2),COMP=$P(COMP,"\",2),COMP=$E($P(COMP,";"),1,3),COMPSEQ=$S($D(ORAY(COMP)):ORAY(COMP),1:99) D
  1. . I '$D(^TMP("ZTRAN",$J,$P(ID,"."),COMPSEQ)) S ^TMP("ZTRAN",$J,$P(ID,"."),COMPSEQ)=GMR_"^"_1 Q
  1. . S CNT=$P(^TMP("ZTRAN",$J,$P(ID,"."),COMPSEQ),"^",3),$P(^(COMPSEQ),"^",3)=CNT+1
  1. I $O(^TMP("ZTRAN",$J,0)) D
  1. . W !,"Sorted/grouped Transfused Units: ",! S ID=0
  1. . F S ID=$O(^TMP("ZTRAN",$J,ID)) Q:'ID S COMP="" F S COMP=$O(^TMP("ZTRAN",$J,ID,COMP)) Q:COMP="" S GMR=^(COMP) D
  1. .. I $P(GMR,"^",3) S $P(GMR,"^",2)=$P(GMR,"^",3)_"\"_$P($P(GMR,"^",2),"\",2)
  1. .. D PARSE,WRT
  1. I $O(^TMP("TRAN",$J,0)) D
  1. . W !,"Transfused Units (from VBECS API): ",! S ID=0
  1. . F S ID=$O(^TMP("TRAN",$J,ID)) Q:'ID S GMR=^(ID) D
  1. .. D PARSE,WRT
  1. . I $O(^TMP("TRAN",$J,"A"))'="" D
  1. .. W !," Blood Product Key: "
  1. . S GMI="A" F S GMI=$O(^TMP("TRAN",$J,GMI)) Q:GMI="" D
  1. .. W ?22,GMI," = ",$G(^TMP("TRAN",$J,GMI)),!
  1. Q
  1. TRRX ;Test call to TRRX^VBECA1 for Transfusion Reactions - DBIA 3181, 3187
  1. N ARR,ID,ERROR,ORPARNT
  1. I '$G(ORVP) D GETPAT(.ERROR)
  1. I $G(ERROR) W !,"Error on Patient lookup" Q
  1. D TRRX^VBECA1(PATID,PATNAM,PATDOB,.ORPARNT,.ORARR) I $O(ARR("TRRX",0)) D
  1. . W !,"Transfusion reactions: " S ID=0 F S ID=$O(ARR("TRRX",ID)) Q:'ID W !?2,ARR("TRRX",ID)
  1. Q
  1. PARSE ;Parse Record
  1. N GMI,X
  1. S TD=$$FMTE^XLFDT(+GMR)
  1. S GMA(1)=$P(GMR,U,2),BPN=$L(GMA(1),";")
  1. I $P(GMA(1),";",BPN)="" S BPN=BPN-1
  1. F GMI=2:1:BPN S GMA(GMI)="("_$P($P(GMA(1),";",GMI),"\")_") "_$P($P(GMA(1),";",GMI),"\",2)
  1. S GMA(1)="("_$P($P(GMA(1),";",1),"\")_") "_$P($P(GMA(1),";",1),"\",2)
  1. Q
  1. WRT ; Writes the Transfusion Record for each day
  1. N GML,GMI1,GMI2,GMM,GMJ
  1. S GMM=$S(BPN#4:1,1:0),GML=BPN\4+GMM
  1. W TD
  1. F GMI1=1:1:GML D
  1. . F GMI2=1:1:($S((GMI1=GML)&(BPN#4):BPN#4,1:4)) D
  1. .. S GMJ=((GMI1-1)*4)+GMI2
  1. .. W ?(((GMI2-1)*15)+13),GMA(GMJ)
  1. .. I $S(GMI2#4=0:1,GMI2=BPN:1,GMI2+(4*(GMI1-1))=BPN:1,1:0) W !
  1. Q