- ORWLR3 ; slc/dcm - VBEC Blood Bank Report cont. ;11/13/07 15:19
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**212,309,332**;Dec 17, 1997;Build 44
- RPT ;Pull report data from VBECS
- N ORI,ORJ,ORK,ORT,ORL,ORRY,REQX,CMT,C,ID,T,CFAG,CNTR,BUMP,OR4
- K ^TMP("VBDATA",$J),^TMP("ORCAN",$J)
- ;Antibodies
- D ABID^VBECA1(PATID,PATNAM,PATDOB,.ORPARENT,.ORRY)
- I $O(ORRY("ABID",0)) D
- . D LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM),LN
- . S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(0,.CCNT,"ANTIBODIES IDENTIFIED: ",.CCNT),ID=0
- . D LN F S ID=$O(ORRY("ABID",ID)) Q:'ID D
- .. S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(0,.CCNT,$G(ORRY("ABID",ID)),.CCNT)
- .. I $O(ORRY("ABID",ID,0)) D
- ... D LN S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(2,.CCNT,"COMMENT:",.CCNT) D LN
- ... S CMT=0 F S CMT=$O(ORRY("ABID",ID,CMT)) Q:'CMT S C=ORRY("ABID",ID,CMT) D
- .... D LN S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(2,.CCNT,C,.CCNT)
- ... D LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM),LN
- ;Transfusion reactions
- D TRRX^VBECA1(PATID,PATNAM,PATDOB,.ORPARENT,.ORRY)
- I $O(ORRY("TRRX",0)) D
- . D LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM),LN
- . S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(0,.CCNT,"TRANSFUSION REACTIONS:",.CCNT) D LN
- . S ID=0 F S ID=$O(ORRY("TRRX",ID)) Q:'ID S X=ORRY("TRRX",ID) D
- .. S Y=$TR($$FMTE^XLFDT(+X,"M"),"@"," ") D LN
- .. S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(3,.CCNT,"Type: "_$S($P(X,U,2)]"":$P(X,U,2),1:"Unknown"),.CCNT) D LN
- .. S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(6,.CCNT,"Date/Time",.CCNT)_$$S^ORU4(35,.CCNT,"Unit ID",.CCNT)_$$S^ORU4(66,.CCNT,"Component",.CCNT) D LN
- .. S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(6,.CCNT,"---------",.CCNT)_$$S^ORU4(35,.CCNT,"-------",.CCNT)_$$S^ORU4(66,.CCNT,"---------",.CCNT) D LN
- .. S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(6,.CCNT,$S(Y]"":Y,1:"Unknown"),.CCNT)_$$S^ORU4(35,.CCNT,$S($P(X,U,3)]"":$P(X,U,3),1:"Unknown"),.CCNT)_$$S^ORU4(66,.CCNT,$S($P(X,U,4)]"":$P(X,U,4),1:"Unknown"),.CCNT)
- .. I $O(ORRY("TRRX",ID,0)) D
- ... D LN S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(6,.CCNT,"Comment:",.CCNT) D LN
- ... S CMT=0 F S CMT=$O(ORRY("TRRX",ID,CMT)) Q:'CMT S C=ORRY("TRRX",ID,CMT) D
- .... D LN S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(6,.CCNT,C,.CCNT)
- .. D LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM),LN
- D LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM)
- ;Xmatched units, Component requests, Diagnostic test results
- D DFN^VBECA3A(DFN)
- ;Available Units
- D AVUNIT^VBECA4(DFN,"LRB") ;New Improved Format
- N INDEX,UNT,ORY,I,CNT,J,K,L,M,X,T,ORASSDT,OREXPDT,ORI,ID,PARAM,ORLOCAB
- S CNT=0,PARAM=+$$GET^XPAR("DIV^SYS^PKG","OR VBECS AVAIL UNITS FORMAT"),ORLOCAB=0
- I $D(ORPRTING)!(+$$GET^XPAR("DIV^SYS^PKG","OR VBECS LOC ABBREV BB REPORT")),PARAM'=1 S ORLOCAB=1 ;Location Abbreviation flag
- K ^TMP("ORUTMP",$J)
- I $O(^TMP("LRB",$J,0)) D
- . K ^TMP("ORUTMP",$J)
- . N ORI,ORL,ORDIV,ORASSDT,ORX,X,ORCNT,ORM,I,C1,C2,C3,C4,C5,C6,C7,C8,Y,H1,H2,H3,H4,H5,H6,H7,H8
- . N ROWSIZ,ORSPLIT
- . S ORSPLIT=0
- . S ORM(1)=14,ORM(2)=7,ORM(3)=7,ORM(4)=9,ORM(5)=6,ORM(6)=9,ORM(7)=$S(ORLOCAB:6,1:8),ORM(8)=8
- . S ORM(1,1)=14,ORM(1,2)=11,ORM(1,4)=9,ORM(2,5)=6,ORM(2,6)=9,ORM(2,7)=$S(ORLOCAB:6,1:8),ORM(2,8)=8
- . S (ORCNT,ORI)=0 F S ORI=$O(^TMP("LRB",$J,ORI)) Q:ORI<1 S ID=^(ORI) D
- .. S ORX(1)=$$FMTE^XLFDT(9999999-ORI,"5M") ;Assigned Date/Time
- .. S ORX(2)=$P(ID,"^",3) ;Unit ID
- .. S ORX(3)=$P(ID,"^",11) ; Product ID
- .. S ORX(4)=$P(ID,"^",4) ;Component
- .. S X=$S($P(ID,"^",7)="P":"Pos",$P(ID,"^",7)="N":"Neg",1:$P(ID,"^",7)) S ORX(5)=$P(ID,"^",6)_" "_X ;ABO/Rh
- .. S ORX(6)=$P(ID,"^",2) ;Expiration Date
- .. S ORX(7)=$P(ID,"^",10) ;Location
- .. S ORX(8)=$P(ID,"^",9) ;Division NAME
- .. I ORLOCAB D
- ... S X=ORX(7)
- ... I $L(X) S Y=$O(^SC("B",X,0)) I Y S X=$S($L($P($G(^SC(Y,0)),"^",2)):$P(^(0),"^",2),1:$E(X,1,7)) S ORX(7)=X ;Location
- ... E S ORX(7)=$E(X,1,7)
- .. S X=$$LKUP^XUAF4(ORX(8)) I X,PARAM'=1,$D(ORPRTING) S X=$$NS^XUAF4(X) I $L($P(X,"^",2)) S ORX(8)=$P(X,"^",2) ;Get Division #
- .. S ORCNT=ORCNT+1,^TMP("ORUTMP",$J,ORCNT)=ORX(1)_"^"_ORX(2)_"^"_ORX(3)_"^"_ORX(4)_"^"_ORX(5)_"^"_ORX(6)_"^"_ORX(7)_"^"_ORX(8)
- .. F I=1:1:8 I $L(ORX(I))>ORM(I) S:ORM(I)<$L(ORX(I)) ORM(I)=$L(ORX(I)) ;Expand column width to fit data size
- .. S C1=1,C2=C1+ORM(1),C3=C2+ORM(2),C4=C3+ORM(3),C5=C4+ORM(4),C6=C5+ORM(5),C7=C6+ORM(6),C8=C7+ORM(7)
- .. S ROWSIZ=C8+$L(ORX(8))+8
- .. I ROWSIZ>79,'ORSPLIT S:PARAM=0 ORSPLIT=0 S:PARAM=2 ORSPLIT=1 S:$D(ORPRTING) ORSPLIT=1
- .. I ORSPLIT D
- ... F I=1,2,4 I $L(ORX(I))>ORM(1,I) S ORM(1,I)=$L(ORX(I)) ;Expand 1st Row column width to fit data
- ... I $L(ORX(3))>$L(ORX(2)) S:$L(ORX(3))>ORM(1,2) ORM(1,2)=$L(ORX(3)) ;Get larger of 2 stacked columns
- ... I $L(ORX(2))>$L(ORX(3)) S:$L(ORX(2))>ORM(1,2) ORM(1,2)=$L(ORX(2))
- ... F I=5:1:8 I $L(ORX(I))>ORM(2,I) S ORM(2,I)=$L(ORX(I)) ;Expand 2nd Row column width to fit data
- . D LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM)
- . S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(0,.CCNT,"AVAILABLE/ISSUED UNITS:",.CCNT)
- . I PARAM'=1 D
- .. D LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM)
- .. I 'ORSPLIT D
- ... F I=1:1:8 S ORM(I)=ORM(I)+1 ;Add 1 space between columns
- ... S C1=1,C2=C1+ORM(1),C3=C2+ORM(2),C4=C3+ORM(3),C5=C4+ORM(4),C6=C5+ORM(5),C7=C6+ORM(6),C8=C7+ORM(7)
- ... D LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM)
- ... S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(C1,.CCNT,"Date Assigned",.CCNT)_$$S^ORU4(C2,.CCNT,"Unit ID",.CCNT)_$$S^ORU4(C3,.CCNT,"Prod ID",.CCNT)_$$S^ORU4(C4,.CCNT,"Component",.CCNT)_$$S^ORU4(C5,.CCNT,"ABO/Rh",.CCNT)
- ... S ^TMP("ORLRC",$J,GCNT,0)=^TMP("ORLRC",$J,GCNT,0)_$$S^ORU4(C6,.CCNT,"Exp. Date",.CCNT)_$$S^ORU4(C7,.CCNT,$S(ORLOCAB:"Locale",1:"Location"),.CCNT)_$$S^ORU4(C8,.CCNT,$S($D(ORPRTING):"Div #",1:"Division"),.CCNT)
- ... D LN
- ... S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(C1,.CCNT,"-------------",.CCNT)_$$S^ORU4(C2,.CCNT,"-------",.CCNT)_$$S^ORU4(C3,.CCNT,"-------",.CCNT)_$$S^ORU4(C4,.CCNT,"---------",.CCNT)_$$S^ORU4(C5,.CCNT,"------",.CCNT)
- ... S ^TMP("ORLRC",$J,GCNT,0)=^TMP("ORLRC",$J,GCNT,0)_$$S^ORU4(C6,.CCNT,"---------",.CCNT)_$$S^ORU4(C7,.CCNT,$S(ORLOCAB:"------",1:"--------"),.CCNT)_$$S^ORU4(C8,.CCNT,$S($D(ORPRTING):"-----",1:"--------"),.CCNT)
- ... D LN
- .. I ORSPLIT D
- ... F I=1,2,4 S ORM(1,I)=ORM(1,I)+1 ;Add 1 spaces between columns 1st Row
- ... F I=5:1:8 S ORM(2,I)=ORM(2,I)+1 ;Add 1 spaces between columns 2nd Row
- ... S H1=1,H2=H1+ORM(1,1)+1,H3=H2+ORM(1,2),H4=H3+17,H5=H4+ORM(2,5),H6=H5+ORM(2,6),H7=H6+ORM(2,7),H8=H7+ORM(2,8)
- ... D LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM)
- ... S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(H1,.CCNT,"Date Assigned",.CCNT)_$$S^ORU4(H2,.CCNT,"Unit/Prod #",.CCNT)_$$S^ORU4(H3,.CCNT,"Component",.CCNT)_$$S^ORU4($S(CCNT<29:29,1:H4),.CCNT,"ABO/Rh",.CCNT)
- ... S ^TMP("ORLRC",$J,GCNT,0)=^TMP("ORLRC",$J,GCNT,0)_$$S^ORU4($S(CCNT<46:46,1:H5),.CCNT,"Exp. Date",.CCNT)_$$S^ORU4($S(CCNT<57:57,1:H6),.CCNT,$S(ORLOCAB:"Locale",1:"Location"),.CCNT)
- ... S ^TMP("ORLRC",$J,GCNT,0)=^TMP("ORLRC",$J,GCNT,0)_$$S^ORU4($S(CCNT<65:65,1:H7),.CCNT,$S($D(ORPRTING):"Div #",1:"Division"),.CCNT)
- ... D LN
- ... S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(H1,.CCNT,"---------------",.CCNT)_$$S^ORU4(H2,.CCNT,"-----------",.CCNT)_$$S^ORU4(H3,.CCNT,"---------",.CCNT)_$$S^ORU4($S(CCNT<29:29,1:H4),.CCNT,"------",.CCNT)
- ... S ^TMP("ORLRC",$J,GCNT,0)=^TMP("ORLRC",$J,GCNT,0)_$$S^ORU4($S(CCNT<46:46,1:H5),.CCNT,"----------",.CCNT)_$$S^ORU4($S(CCNT<57:57,1:H6),.CCNT,$S(ORLOCAB:"------",1:"--------"),.CCNT)
- ... S ^TMP("ORLRC",$J,GCNT,0)=^TMP("ORLRC",$J,GCNT,0)_$$S^ORU4($S(CCNT<65:65,1:H7),.CCNT,$S($D(ORPRTING):"-----",1:"--------"),.CCNT)
- ... D LN
- . S ORI=0 F S ORI=$O(^TMP("ORUTMP",$J,ORI)) Q:'ORI S ID=^(ORI) D
- .. I PARAM'=1 D
- ... I 'ORSPLIT D
- .... D LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM)
- .... S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(C1,.CCNT,$P(ID,"^"),.CCNT)_$$S^ORU4(C2,.CCNT,$P(ID,"^",2),.CCNT)_$$S^ORU4(C3,.CCNT,$P(ID,"^",3),.CCNT)_$$S^ORU4(C4,.CCNT,$P(ID,"^",4),.CCNT)_$$S^ORU4(C5,.CCNT,$P(ID,"^",5),.CCNT)
- .... S ^TMP("ORLRC",$J,GCNT,0)=^TMP("ORLRC",$J,GCNT,0)_$$S^ORU4(C6,.CCNT,$P(ID,"^",6),.CCNT)_$$S^ORU4(C7,.CCNT,$P(ID,"^",7),.CCNT)_$$S^ORU4(C8,.CCNT,$P(ID,"^",8),.CCNT)
- ... I ORSPLIT D
- .... D LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM)
- .... S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(H1,.CCNT,$P(ID,"^"),.CCNT)_$$S^ORU4(H2,.CCNT,$P(ID,"^",2),.CCNT)_$$S^ORU4(H3,.CCNT,$P(ID,"^",4),.CCNT)
- .... D LN
- .... S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(H1,.CCNT,"",.CCNT)_$$S^ORU4(H2,.CCNT,$P(ID,"^",3),.CCNT)_$$S^ORU4(H3,.CCNT,"",.CCNT)_$$S^ORU4($S(CCNT<29:29,1:H4),.CCNT,$P(ID,"^",5),.CCNT)
- .... S ^TMP("ORLRC",$J,GCNT,0)=^TMP("ORLRC",$J,GCNT,0)_$$S^ORU4($S(CCNT<46:46,1:H5),.CCNT,$P(ID,"^",6),.CCNT)_$$S^ORU4($S(CCNT<57:57,1:H6),.CCNT,$P(ID,"^",7),.CCNT)_$$S^ORU4($S(CCNT<65:65,1:H7),.CCNT,$P(ID,"^",8),.CCNT)
- .... D LN
- .. I PARAM=1 D
- ... D LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM)
- ... D LN S ^TMP("ORLRC",$J,GCNT,0)=" Date/Time Assigned: "_$$S^ORU4(1,.CCNT,$P(ID,"^",1),.CCNT)
- ... D LN S ^TMP("ORLRC",$J,GCNT,0)=" Unit ID : "_$$S^ORU4(1,.CCNT,$P(ID,"^",2),.CCNT)
- ... D LN S ^TMP("ORLRC",$J,GCNT,0)=" Product ID : "_$$S^ORU4(1,.CCNT,$P(ID,"^",3),.CCNT)
- ... D LN S ^TMP("ORLRC",$J,GCNT,0)=" Component : "_$$S^ORU4(1,.CCNT,$P(ID,"^",4),.CCNT)
- ... D LN S ^TMP("ORLRC",$J,GCNT,0)=" ABO/Rh : "_$$S^ORU4(1,.CCNT,$P(ID,"^",5),.CCNT)
- ... D LN S ^TMP("ORLRC",$J,GCNT,0)=" Expiration Date : "_$$S^ORU4(1,.CCNT,$P(ID,"^",6),.CCNT)
- ... D LN S ^TMP("ORLRC",$J,GCNT,0)=" Location : "_$$S^ORU4(1,.CCNT,$P(ID,"^",7),.CCNT)
- ... D LN S ^TMP("ORLRC",$J,GCNT,0)=" Division : "_$$S^ORU4(1,.CCNT,$P(ID,"^",8),.CCNT)
- D LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM)
- K ^TMP("LRB",$J),^TMP("ORUTMP",$J)
- ;Specimen Tests
- D SPEC^ORWLR4
- ;Component Requests
- N A,F,%DT,Y,SORT,CNT
- I $O(^TMP("VBDATA",$J,"COMPONENT REQUEST",0)) D
- . D LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM),LN
- . D LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM),LN
- . S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(0,.CCNT,"COMPONENT REQUESTS:",.CCNT)
- . D LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM),LN
- . S X="Component Type"
- . S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(2,.CCNT,X,.CCNT)_$$S^ORU4(22,.CCNT,"Units",.CCNT)_$$S^ORU4(28,.CCNT,"Request date",.CCNT)_$$S^ORU4(48,.CCNT,"Date wanted",.CCNT)_$$S^ORU4(68,.CCNT,"Requestor",.CCNT)_$$S^ORU4(78,.CCNT,"By",.CCNT) D LN
- . S Y="--------------"
- . S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(2,.CCNT,Y,.CCNT)_$$S^ORU4(22,.CCNT,"-----",.CCNT)_$$S^ORU4(28,.CCNT,"------------",.CCNT)_$$S^ORU4(48,.CCNT,"-----------",.CCNT)_$$S^ORU4(68,.CCNT,"---------",.CCNT)_$$S^ORU4(78,.CCNT,"--",.CCNT) D LN
- . S CNT=0,A=0 F S A=$O(^TMP("VBDATA",$J,"COMPONENT REQUEST",A)) Q:'A D
- .. S F=^TMP("VBDATA",$J,"COMPONENT REQUEST",A),T="",%DT="T",X=$P(F,"^",3),Y=-1
- .. I $L(X) D ^%DT
- .. I Y'=-1 S T=Y D T^ORWLR2
- .. S CNT=CNT+1,SORT=$S($P(F,"^",3):$P(F,"^",3),$P(F,"^",4):$P(F,"^",4),1:0),^TMP("ORTMP",$J,9999999-SORT,CNT,0)=F
- . S ORI=0 F S ORI=$O(^TMP("ORTMP",$J,ORI)) Q:'ORI S CNT=0 F S CNT=$O(^TMP("ORTMP",$J,ORI,CNT)) Q:'CNT I $D(^(CNT,0)) S F=^(0) D
- .. D LN
- .. S T="",%DT="T",X=$P(F,"^",3),Y=-1
- .. I $L(X) D ^%DT
- .. I Y'=-1 S T=Y D T^ORWLR2
- .. S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(2,.CCNT,$E($P(F,"^"),1,25),.CCNT)_$$S^ORU4(22,.CCNT,$J($P(F,"^",2),3),.CCNT)_$$S^ORU4(28,.CCNT,T,.CCNT)
- .. S T="",%DT="T",X=$P(F,"^",4),Y=-1
- .. I $L(X) D ^%DT
- .. I Y'=-1 S T=Y D T^ORWLR2
- .. S X=$S($P(F,"^",6):$P(F,"^",6)_",",1:""),X=$S($L(X):$$GET1^DIQ(200,X,1),1:$P(F,"^",6))
- .. S REQX=$S($P(F,"^",5):$P(F,"^",5)_",",1:""),REQX=$S($L(REQX):$$GET1^DIQ(200,REQX,1),1:$P(F,"^",5))
- .. S ^TMP("ORLRC",$J,GCNT,0)=^TMP("ORLRC",$J,GCNT,0)_$$S^ORU4(48,.CCNT,T,.CCNT)_$$S^ORU4(68,.CCNT,REQX,.CCNT)_$$S^ORU4(78,.CCNT,X,.CCNT)
- K ^TMP("ORTMP",$J)
- ;Transfused Units
- D LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM),LN
- D TRAN^ORWLR2
- Q
- CAN(OROOT,COL) ;Take data from OROOT and build ^TMP("ORCAN",$J)
- N START,STOP,INPUT,OUTPUT,CCNT,CNT,WORD,ORX,NEX,CJ,CTR,ORX,ICNT
- D SPACE(OROOT)
- S CCNT=1,CNT=$S($O(^TMP("ORCAN",$J,0)):$O(^TMP("ORCAN",$J,99999999),-1),1:0)
- S OUTPUT="",ORK=3
- F S ORK=$O(@OROOT@(ORK)) Q:'ORK S X=@OROOT@(ORK) D
- . I ORK=4 S CNT=CNT+1,^TMP("ORCAN",$J,CNT,0)=$$S^ORU4(1,.CCNT,CFAG,.CCNT)
- . S INPUT=OUTPUT_X,START=$S($E(INPUT)=" ":2,1:1),OUTPUT="",STOP=$L(INPUT," ")
- . I $L(INPUT) F ICNT=START:1:STOP S WORD=$P(INPUT," ",ICNT) D
- .. I $L(WORD)<1,$L(OUTPUT) S CNT=CNT+1,^TMP("ORCAN",$J,CNT,0)=$$S^ORU4(1,.CCNT,OUTPUT,.CCNT),OUTPUT="" Q
- .. I ICNT=$L(INPUT," "),+$O(@OROOT@(ORK))<1,'$L($P(INPUT," ",ICNT+1)),$L(OUTPUT) D Q
- ... S OUTPUT=$S($L(OUTPUT):OUTPUT_" "_WORD,1:WORD),CNT=CNT+1,^TMP("ORCAN",$J,CNT,0)=$$S^ORU4(1,.CCNT,OUTPUT,.CCNT),OUTPUT=""
- .. I $L(WORD)>COL D S OUTPUT="" Q
- ... I $L(WORD," ")=1 S CNT=CNT+1,^TMP("ORCAN",$J,CNT,0)=$$S^ORU4(1,.CCNT,WORD,.CCNT) Q
- ... F CJ=1:COL S OUTPUT=$E(WORD,CJ,CJ+99) Q:'$L(OUTPUT) S CNT=CNT+1,^TMP("ORCAN",$J,CNT,0)=$$S^ORU4(1,.CCNT,OUTPUT,.CCNT)
- .. I $L(OUTPUT)+$L(WORD)>COL S CNT=CNT+1,^TMP("ORCAN",$J,CNT,0)=$$S^ORU4(1,.CCNT,OUTPUT,.CCNT),OUTPUT="" D Q
- ... I $L(WORD)>COL D
- .... I $L(WORD," ")=1 S CNT=CNT+1,^TMP("ORCAN",$J,CNT,0)=$$S^ORU4(1,.CCNT,WORD,.CCNT) Q
- .... F CJ=1:COL S OUTPUT=$E(WORD,CJ,CJ+99) Q:'$L(OUTPUT) S CNT=CNT+1,^TMP("ORCAN",$J,CNT,0)=$$S^ORU4(1,.CCNT,OUTPUT,.CCNT)
- .... S OUTPUT=""
- ... E S OUTPUT=OUTPUT_$S($L(OUTPUT):" ",1:"")_WORD D
- .... I ICNT=$L(INPUT," ") D
- ..... I +$O(@OROOT@(ORK))<1 S CNT=CNT+1,^TMP("ORCAN",$J,CNT,0)=$$S^ORU4(1,.CCNT,OUTPUT,.CCNT),OUTPUT="" Q
- .. S OUTPUT=$S($L(OUTPUT):OUTPUT_" "_WORD,1:WORD)
- .. I $L(OUTPUT)>COL S CNT=CNT+1,^TMP("ORCAN",$J,CNT,0)=$$S^ORU4(1,.CCNT,OUTPUT,.CCNT),OUTPUT=""
- .. I ICNT=$L(INPUT," ") D
- ... I +$O(@OROOT@(ORK))<1 S CNT=CNT+1,^TMP("ORCAN",$J,CNT,0)=$$S^ORU4(1,.CCNT,OUTPUT,.CCNT),OUTPUT=""
- Q
- SPACE(OROOT) ;Move Trailing spaces to next line
- N ORI,CTR,X
- S ORI=0
- F S ORI=$O(@OROOT@(ORI)) Q:'ORI D
- . S X=$RE(@OROOT@(ORI)),CTR=0 F S:$E(X)=" " X=$E(X,2,999),CTR=CTR+1 Q:$E(X)'=" " Q:'$L(X) ;trailing spaces removed
- . I CTR S @OROOT@(ORI)=$RE(X) I $O(@OROOT@(ORI)) S NEX=$O(@OROOT@(ORI)),ORX(NEX)=$E(" ",1,CTR)_ORX(NEX) ;move spaces to front of next line
- Q
- LN ;Increment counts
- S GCNT=GCNT+1,CCNT=1
- Q
- TRIM(X) ;Trim leading and trailing spaces
- S X=$RE(X) F S:$E(X)=" " X=$E(X,2,999) Q:$E(X)'=" " Q:'$L(X) ;trail
- S X=$RE(X) F S:$E(X)=" " X=$E(X,2,999) Q:$E(X)'=" " Q:'$L(X) ;lead
- Q X
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWLR3 14193 printed Feb 19, 2025@00:03:10 Page 2
- ORWLR3 ; slc/dcm - VBEC Blood Bank Report cont. ;11/13/07 15:19
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**212,309,332**;Dec 17, 1997;Build 44
- RPT ;Pull report data from VBECS
- +1 NEW ORI,ORJ,ORK,ORT,ORL,ORRY,REQX,CMT,C,ID,T,CFAG,CNTR,BUMP,OR4
- +2 KILL ^TMP("VBDATA",$JOB),^TMP("ORCAN",$JOB)
- +3 ;Antibodies
- +4 DO ABID^VBECA1(PATID,PATNAM,PATDOB,.ORPARENT,.ORRY)
- +5 IF $ORDER(ORRY("ABID",0))
- Begin DoDot:1
- +6 DO LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM)
- DO LN
- +7 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(0,.CCNT,"ANTIBODIES IDENTIFIED: ",.CCNT)
- SET ID=0
- +8 DO LN
- FOR
- SET ID=$ORDER(ORRY("ABID",ID))
- if 'ID
- QUIT
- Begin DoDot:2
- +9 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(0,.CCNT,$GET(ORRY("ABID",ID)),.CCNT)
- +10 IF $ORDER(ORRY("ABID",ID,0))
- Begin DoDot:3
- +11 DO LN
- SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(2,.CCNT,"COMMENT:",.CCNT)
- DO LN
- +12 SET CMT=0
- FOR
- SET CMT=$ORDER(ORRY("ABID",ID,CMT))
- if 'CMT
- QUIT
- SET C=ORRY("ABID",ID,CMT)
- Begin DoDot:4
- +13 DO LN
- SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(2,.CCNT,C,.CCNT)
- End DoDot:4
- +14 DO LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM)
- DO LN
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +15 ;Transfusion reactions
- +16 DO TRRX^VBECA1(PATID,PATNAM,PATDOB,.ORPARENT,.ORRY)
- +17 IF $ORDER(ORRY("TRRX",0))
- Begin DoDot:1
- +18 DO LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM)
- DO LN
- +19 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(0,.CCNT,"TRANSFUSION REACTIONS:",.CCNT)
- DO LN
- +20 SET ID=0
- FOR
- SET ID=$ORDER(ORRY("TRRX",ID))
- if 'ID
- QUIT
- SET X=ORRY("TRRX",ID)
- Begin DoDot:2
- +21 SET Y=$TRANSLATE($$FMTE^XLFDT(+X,"M"),"@"," ")
- DO LN
- +22 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(3,.CCNT,"Type: "_$SELECT($PIECE(X,U,2)]"":$PIECE(X,U,2),1:"Unknown"),.CCNT)
- DO LN
- +23 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(6,.CCNT,"Date/Time",.CCNT)_$$S^ORU4(35,.CCNT,"Unit ID",.CCNT)_$$S^ORU4(66,.CCNT,"Component",.CCNT)
- DO LN
- +24 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(6,.CCNT,"---------",.CCNT)_$$S^ORU4(35,.CCNT,"-------",.CCNT)_$$S^ORU4(66,.CCNT,"---------",.CCNT)
- DO LN
- +25 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(6,.CCNT,$SELECT(Y]"":Y,1:"Unknown"),.CCNT)_$$S^ORU4(35,.CCNT,$SELECT($PIECE(X,U,3)]"":$PIECE(X,U,3),1:"Unknown"),.CCNT)_$$S^ORU4(66,.CCNT,$SELECT($PIECE(X,U,4)]"":$PIECE(X,U,4),1:"Unknown")
- ,.CCNT)
- +26 IF $ORDER(ORRY("TRRX",ID,0))
- Begin DoDot:3
- +27 DO LN
- SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(6,.CCNT,"Comment:",.CCNT)
- DO LN
- +28 SET CMT=0
- FOR
- SET CMT=$ORDER(ORRY("TRRX",ID,CMT))
- if 'CMT
- QUIT
- SET C=ORRY("TRRX",ID,CMT)
- Begin DoDot:4
- +29 DO LN
- SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(6,.CCNT,C,.CCNT)
- End DoDot:4
- End DoDot:3
- +30 DO LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM)
- DO LN
- End DoDot:2
- End DoDot:1
- +31 DO LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM)
- +32 ;Xmatched units, Component requests, Diagnostic test results
- +33 DO DFN^VBECA3A(DFN)
- +34 ;Available Units
- +35 ;New Improved Format
- DO AVUNIT^VBECA4(DFN,"LRB")
- +36 NEW INDEX,UNT,ORY,I,CNT,J,K,L,M,X,T,ORASSDT,OREXPDT,ORI,ID,PARAM,ORLOCAB
- +37 SET CNT=0
- SET PARAM=+$$GET^XPAR("DIV^SYS^PKG","OR VBECS AVAIL UNITS FORMAT")
- SET ORLOCAB=0
- +38 ;Location Abbreviation flag
- IF $DATA(ORPRTING)!(+$$GET^XPAR("DIV^SYS^PKG","OR VBECS LOC ABBREV BB REPORT"))
- IF PARAM'=1
- SET ORLOCAB=1
- +39 KILL ^TMP("ORUTMP",$JOB)
- +40 IF $ORDER(^TMP("LRB",$JOB,0))
- Begin DoDot:1
- +41 KILL ^TMP("ORUTMP",$JOB)
- +42 NEW ORI,ORL,ORDIV,ORASSDT,ORX,X,ORCNT,ORM,I,C1,C2,C3,C4,C5,C6,C7,C8,Y,H1,H2,H3,H4,H5,H6,H7,H8
- +43 NEW ROWSIZ,ORSPLIT
- +44 SET ORSPLIT=0
- +45 SET ORM(1)=14
- SET ORM(2)=7
- SET ORM(3)=7
- SET ORM(4)=9
- SET ORM(5)=6
- SET ORM(6)=9
- SET ORM(7)=$SELECT(ORLOCAB:6,1:8)
- SET ORM(8)=8
- +46 SET ORM(1,1)=14
- SET ORM(1,2)=11
- SET ORM(1,4)=9
- SET ORM(2,5)=6
- SET ORM(2,6)=9
- SET ORM(2,7)=$SELECT(ORLOCAB:6,1:8)
- SET ORM(2,8)=8
- +47 SET (ORCNT,ORI)=0
- FOR
- SET ORI=$ORDER(^TMP("LRB",$JOB,ORI))
- if ORI<1
- QUIT
- SET ID=^(ORI)
- Begin DoDot:2
- +48 ;Assigned Date/Time
- SET ORX(1)=$$FMTE^XLFDT(9999999-ORI,"5M")
- +49 ;Unit ID
- SET ORX(2)=$PIECE(ID,"^",3)
- +50 ; Product ID
- SET ORX(3)=$PIECE(ID,"^",11)
- +51 ;Component
- SET ORX(4)=$PIECE(ID,"^",4)
- +52 ;ABO/Rh
- SET X=$SELECT($PIECE(ID,"^",7)="P":"Pos",$PIECE(ID,"^",7)="N":"Neg",1:$PIECE(ID,"^",7))
- SET ORX(5)=$PIECE(ID,"^",6)_" "_X
- +53 ;Expiration Date
- SET ORX(6)=$PIECE(ID,"^",2)
- +54 ;Location
- SET ORX(7)=$PIECE(ID,"^",10)
- +55 ;Division NAME
- SET ORX(8)=$PIECE(ID,"^",9)
- +56 IF ORLOCAB
- Begin DoDot:3
- +57 SET X=ORX(7)
- +58 ;Location
- IF $LENGTH(X)
- SET Y=$ORDER(^SC("B",X,0))
- IF Y
- SET X=$SELECT($LENGTH($PIECE($GET(^SC(Y,0)),"^",2)):$PIECE(^(0),"^",2),1:$EXTRACT(X,1,7))
- SET ORX(7)=X
- +59 IF '$TEST
- SET ORX(7)=$EXTRACT(X,1,7)
- End DoDot:3
- +60 ;Get Division #
- SET X=$$LKUP^XUAF4(ORX(8))
- IF X
- IF PARAM'=1
- IF $DATA(ORPRTING)
- SET X=$$NS^XUAF4(X)
- IF $LENGTH($PIECE(X,"^",2))
- SET ORX(8)=$PIECE(X,"^",2)
- +61 SET ORCNT=ORCNT+1
- SET ^TMP("ORUTMP",$JOB,ORCNT)=ORX(1)_"^"_ORX(2)_"^"_ORX(3)_"^"_ORX(4)_"^"_ORX(5)_"^"_ORX(6)_"^"_ORX(7)_"^"_ORX(8)
- +62 ;Expand column width to fit data size
- FOR I=1:1:8
- IF $LENGTH(ORX(I))>ORM(I)
- if ORM(I)<$LENGTH(ORX(I))
- SET ORM(I)=$LENGTH(ORX(I))
- +63 SET C1=1
- SET C2=C1+ORM(1)
- SET C3=C2+ORM(2)
- SET C4=C3+ORM(3)
- SET C5=C4+ORM(4)
- SET C6=C5+ORM(5)
- SET C7=C6+ORM(6)
- SET C8=C7+ORM(7)
- +64 SET ROWSIZ=C8+$LENGTH(ORX(8))+8
- +65 IF ROWSIZ>79
- IF 'ORSPLIT
- if PARAM=0
- SET ORSPLIT=0
- if PARAM=2
- SET ORSPLIT=1
- if $DATA(ORPRTING)
- SET ORSPLIT=1
- +66 IF ORSPLIT
- Begin DoDot:3
- +67 ;Expand 1st Row column width to fit data
- FOR I=1,2,4
- IF $LENGTH(ORX(I))>ORM(1,I)
- SET ORM(1,I)=$LENGTH(ORX(I))
- +68 ;Get larger of 2 stacked columns
- IF $LENGTH(ORX(3))>$LENGTH(ORX(2))
- if $LENGTH(ORX(3))>ORM(1,2)
- SET ORM(1,2)=$LENGTH(ORX(3))
- +69 IF $LENGTH(ORX(2))>$LENGTH(ORX(3))
- if $LENGTH(ORX(2))>ORM(1,2)
- SET ORM(1,2)=$LENGTH(ORX(2))
- +70 ;Expand 2nd Row column width to fit data
- FOR I=5:1:8
- IF $LENGTH(ORX(I))>ORM(2,I)
- SET ORM(2,I)=$LENGTH(ORX(I))
- End DoDot:3
- End DoDot:2
- +71 DO LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM)
- +72 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(0,.CCNT,"AVAILABLE/ISSUED UNITS:",.CCNT)
- +73 IF PARAM'=1
- Begin DoDot:2
- +74 DO LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM)
- +75 IF 'ORSPLIT
- Begin DoDot:3
- +76 ;Add 1 space between columns
- FOR I=1:1:8
- SET ORM(I)=ORM(I)+1
- +77 SET C1=1
- SET C2=C1+ORM(1)
- SET C3=C2+ORM(2)
- SET C4=C3+ORM(3)
- SET C5=C4+ORM(4)
- SET C6=C5+ORM(5)
- SET C7=C6+ORM(6)
- SET C8=C7+ORM(7)
- +78 DO LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM)
- +79 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(C1,.CCNT,"Date Assigned",.CCNT)_$$S^ORU4(C2,.CCNT,"Unit ID",.CCNT)_$$S^ORU4(C3,.CCNT,"Prod ID",.CCNT)_$$S^ORU4(C4,.CCNT,"Component",.CCNT)_$$S^ORU4(C5,.CCNT,"ABO/Rh",.CCNT)
- +80 SET ^TMP("ORLRC",$JOB,GCNT,0)=^TMP("ORLRC",$JOB,GCNT,0)_$$S^ORU4(C6,.CCNT,"Exp. Date",.CCNT)_$$S^ORU4(C7,.CCNT,$SELECT(ORLOCAB:"Locale",1:"Location"),.CCNT)_$$S^ORU4(C8,.CCNT,$SELECT($DATA(ORPRTING):"Div #",1:"Division")
- ,.CCNT)
- +81 DO LN
- +82 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(C1,.CCNT,"-------------",.CCNT)_$$S^ORU4(C2,.CCNT,"-------",.CCNT)_$$S^ORU4(C3,.CCNT,"-------",.CCNT)_$$S^ORU4(C4,.CCNT,"---------",.CCNT)_$$S^ORU4(C5,.CCNT,"------",.CCNT)
- +83 SET ^TMP("ORLRC",$JOB,GCNT,0)=^TMP("ORLRC",$JOB,GCNT,0)_$$S^ORU4(C6,.CCNT,"---------",.CCNT)_$$S^ORU4(C7,.CCNT,$SELECT(ORLOCAB:"------",1:"--------"),.CCNT)_$$S^ORU4(C8,.CCNT,$SELECT($DATA(ORPRTING):"-----",1:"--------")
- ,.CCNT)
- +84 DO LN
- End DoDot:3
- +85 IF ORSPLIT
- Begin DoDot:3
- +86 ;Add 1 spaces between columns 1st Row
- FOR I=1,2,4
- SET ORM(1,I)=ORM(1,I)+1
- +87 ;Add 1 spaces between columns 2nd Row
- FOR I=5:1:8
- SET ORM(2,I)=ORM(2,I)+1
- +88 SET H1=1
- SET H2=H1+ORM(1,1)+1
- SET H3=H2+ORM(1,2)
- SET H4=H3+17
- SET H5=H4+ORM(2,5)
- SET H6=H5+ORM(2,6)
- SET H7=H6+ORM(2,7)
- SET H8=H7+ORM(2,8)
- +89 DO LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM)
- +90 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(H1,.CCNT,"Date Assigned",.CCNT)_$$S^ORU4(H2,.CCNT,"Unit/Prod #",.CCNT)_$$S^ORU4(H3,.CCNT,"Component",.CCNT)_$$S^ORU4($SELECT(CCNT<29:29,1:H4),.CCNT,"ABO/Rh",.CCNT)
- +91 SET ^TMP("ORLRC",$JOB,GCNT,0)=^TMP("ORLRC",$JOB,GCNT,0)_$$S^ORU4($SELECT(CCNT<46:46,1:H5),.CCNT,"Exp. Date",.CCNT)_$$S^ORU4($SELECT(CCNT<57:57,1:H6),.CCNT,$SELECT(ORLOCAB:"Locale",1:"Location"),.CCNT)
- +92 SET ^TMP("ORLRC",$JOB,GCNT,0)=^TMP("ORLRC",$JOB,GCNT,0)_$$S^ORU4($SELECT(CCNT<65:65,1:H7),.CCNT,$SELECT($DATA(ORPRTING):"Div #",1:"Division"),.CCNT)
- +93 DO LN
- +94 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(H1,.CCNT,"---------------",.CCNT)_$$S^ORU4(H2,.CCNT,"-----------",.CCNT)_$$S^ORU4(H3,.CCNT,"---------",.CCNT)_$$S^ORU4($SELECT(CCNT<29:29,1:H4),.CCNT,"------",.CCNT)
- +95 SET ^TMP("ORLRC",$JOB,GCNT,0)=^TMP("ORLRC",$JOB,GCNT,0)_$$S^ORU4($SELECT(CCNT<46:46,1:H5),.CCNT,"----------",.CCNT)_$$S^ORU4($SELECT(CCNT<57:57,1:H6),.CCNT,$SELECT(ORLOCAB:"------",1:"--------"),.CCNT)
- +96 SET ^TMP("ORLRC",$JOB,GCNT,0)=^TMP("ORLRC",$JOB,GCNT,0)_$$S^ORU4($SELECT(CCNT<65:65,1:H7),.CCNT,$SELECT($DATA(ORPRTING):"-----",1:"--------"),.CCNT)
- +97 DO LN
- End DoDot:3
- End DoDot:2
- +98 SET ORI=0
- FOR
- SET ORI=$ORDER(^TMP("ORUTMP",$JOB,ORI))
- if 'ORI
- QUIT
- SET ID=^(ORI)
- Begin DoDot:2
- +99 IF PARAM'=1
- Begin DoDot:3
- +100 IF 'ORSPLIT
- Begin DoDot:4
- +101 DO LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM)
- +102 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(C1,.CCNT,$PIECE(ID,"^"),.CCNT)_$$S^ORU4(C2,.CCNT,$PIECE(ID,"^",2),.CCNT)_$$S^ORU4(C3,.CCNT,$PIECE(ID,"^",3),.CCNT)_$$S^ORU4(C4,.CCNT,$PIECE(ID,"^",4),.CCNT)_$$S^ORU4(C5,.CCN
- T,$PIECE(ID,"^",5),.CCNT)
- +103 SET ^TMP("ORLRC",$JOB,GCNT,0)=^TMP("ORLRC",$JOB,GCNT,0)_$$S^ORU4(C6,.CCNT,$PIECE(ID,"^",6),.CCNT)_$$S^ORU4(C7,.CCNT,$PIECE(ID,"^",7),.CCNT)_$$S^ORU4(C8,.CCNT,$PIECE(ID,"^",8),.CCNT)
- End DoDot:4
- +104 IF ORSPLIT
- Begin DoDot:4
- +105 DO LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM)
- +106 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(H1,.CCNT,$PIECE(ID,"^"),.CCNT)_$$S^ORU4(H2,.CCNT,$PIECE(ID,"^",2),.CCNT)_$$S^ORU4(H3,.CCNT,$PIECE(ID,"^",4),.CCNT)
- +107 DO LN
- +108 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(H1,.CCNT,"",.CCNT)_$$S^ORU4(H2,.CCNT,$PIECE(ID,"^",3),.CCNT)_$$S^ORU4(H3,.CCNT,"",.CCNT)_$$S^ORU4($SELECT(CCNT<29:29,1:H4),.CCNT,$PIECE(ID,"^",5),.CCNT)
- +109 SET ^TMP("ORLRC",$JOB,GCNT,0)=^TMP("ORLRC",$JOB,GCNT,0)_$$S^ORU4($SELECT(CCNT<46:46,1:H5),.CCNT,$PIECE(ID,"^",6),.CCNT)_$$S^ORU4($SELECT(CCNT<57:57,1:H6),.CCNT,$PIECE(ID,"^",7),.CCNT)_$$S^ORU4($SELECT(CCNT<65:65,
- 1:H7),.CCNT,$PIECE(ID,"^",8),.CCNT)
- +110 DO LN
- End DoDot:4
- End DoDot:3
- +111 IF PARAM=1
- Begin DoDot:3
- +112 DO LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM)
- +113 DO LN
- SET ^TMP("ORLRC",$JOB,GCNT,0)=" Date/Time Assigned: "_$$S^ORU4(1,.CCNT,$PIECE(ID,"^",1),.CCNT)
- +114 DO LN
- SET ^TMP("ORLRC",$JOB,GCNT,0)=" Unit ID : "_$$S^ORU4(1,.CCNT,$PIECE(ID,"^",2),.CCNT)
- +115 DO LN
- SET ^TMP("ORLRC",$JOB,GCNT,0)=" Product ID : "_$$S^ORU4(1,.CCNT,$PIECE(ID,"^",3),.CCNT)
- +116 DO LN
- SET ^TMP("ORLRC",$JOB,GCNT,0)=" Component : "_$$S^ORU4(1,.CCNT,$PIECE(ID,"^",4),.CCNT)
- +117 DO LN
- SET ^TMP("ORLRC",$JOB,GCNT,0)=" ABO/Rh : "_$$S^ORU4(1,.CCNT,$PIECE(ID,"^",5),.CCNT)
- +118 DO LN
- SET ^TMP("ORLRC",$JOB,GCNT,0)=" Expiration Date : "_$$S^ORU4(1,.CCNT,$PIECE(ID,"^",6),.CCNT)
- +119 DO LN
- SET ^TMP("ORLRC",$JOB,GCNT,0)=" Location : "_$$S^ORU4(1,.CCNT,$PIECE(ID,"^",7),.CCNT)
- +120 DO LN
- SET ^TMP("ORLRC",$JOB,GCNT,0)=" Division : "_$$S^ORU4(1,.CCNT,$PIECE(ID,"^",8),.CCNT)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +121 DO LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM)
- +122 KILL ^TMP("LRB",$JOB),^TMP("ORUTMP",$JOB)
- +123 ;Specimen Tests
- +124 DO SPEC^ORWLR4
- +125 ;Component Requests
- +126 NEW A,F,%DT,Y,SORT,CNT
- +127 IF $ORDER(^TMP("VBDATA",$JOB,"COMPONENT REQUEST",0))
- Begin DoDot:1
- +128 DO LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM)
- DO LN
- +129 DO LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM)
- DO LN
- +130 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(0,.CCNT,"COMPONENT REQUESTS:",.CCNT)
- +131 DO LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM)
- DO LN
- +132 SET X="Component Type"
- +133 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(2,.CCNT,X,.CCNT)_$$S^ORU4(22,.CCNT,"Units",.CCNT)_$$S^ORU4(28,.CCNT,"Request date",.CCNT)_$$S^ORU4(48,.CCNT,"Date wanted",.CCNT)_$$S^ORU4(68,.CCNT,"Requestor",.CCNT)_$$S^ORU4(78,.CCNT,"By",.CCNT)
- DO LN
- +134 SET Y="--------------"
- +135 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(2,.CCNT,Y,.CCNT)_$$S^ORU4(22,.CCNT,"-----",.CCNT)_$$S^ORU4(28,.CCNT,"------------",.CCNT)_$$S^ORU4(48,.CCNT,"-----------",.CCNT)_$$S^ORU4(68,.CCNT,"---------",.CCNT)_$$S^ORU4(78,.CCNT,"--",.CCNT)
- DO LN
- +136 SET CNT=0
- SET A=0
- FOR
- SET A=$ORDER(^TMP("VBDATA",$JOB,"COMPONENT REQUEST",A))
- if 'A
- QUIT
- Begin DoDot:2
- +137 SET F=^TMP("VBDATA",$JOB,"COMPONENT REQUEST",A)
- SET T=""
- SET %DT="T"
- SET X=$PIECE(F,"^",3)
- SET Y=-1
- +138 IF $LENGTH(X)
- DO ^%DT
- +139 IF Y'=-1
- SET T=Y
- DO T^ORWLR2
- +140 SET CNT=CNT+1
- SET SORT=$SELECT($PIECE(F,"^",3):$PIECE(F,"^",3),$PIECE(F,"^",4):$PIECE(F,"^",4),1:0)
- SET ^TMP("ORTMP",$JOB,9999999-SORT,CNT,0)=F
- End DoDot:2
- +141 SET ORI=0
- FOR
- SET ORI=$ORDER(^TMP("ORTMP",$JOB,ORI))
- if 'ORI
- QUIT
- SET CNT=0
- FOR
- SET CNT=$ORDER(^TMP("ORTMP",$JOB,ORI,CNT))
- if 'CNT
- QUIT
- IF $DATA(^(CNT,0))
- SET F=^(0)
- Begin DoDot:2
- +142 DO LN
- +143 SET T=""
- SET %DT="T"
- SET X=$PIECE(F,"^",3)
- SET Y=-1
- +144 IF $LENGTH(X)
- DO ^%DT
- +145 IF Y'=-1
- SET T=Y
- DO T^ORWLR2
- +146 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(2,.CCNT,$EXTRACT($PIECE(F,"^"),1,25),.CCNT)_$$S^ORU4(22,.CCNT,$JUSTIFY($PIECE(F,"^",2),3),.CCNT)_$$S^ORU4(28,.CCNT,T,.CCNT)
- +147 SET T=""
- SET %DT="T"
- SET X=$PIECE(F,"^",4)
- SET Y=-1
- +148 IF $LENGTH(X)
- DO ^%DT
- +149 IF Y'=-1
- SET T=Y
- DO T^ORWLR2
- +150 SET X=$SELECT($PIECE(F,"^",6):$PIECE(F,"^",6)_",",1:"")
- SET X=$SELECT($LENGTH(X):$$GET1^DIQ(200,X,1),1:$PIECE(F,"^",6))
- +151 SET REQX=$SELECT($PIECE(F,"^",5):$PIECE(F,"^",5)_",",1:"")
- SET REQX=$SELECT($LENGTH(REQX):$$GET1^DIQ(200,REQX,1),1:$PIECE(F,"^",5))
- +152 SET ^TMP("ORLRC",$JOB,GCNT,0)=^TMP("ORLRC",$JOB,GCNT,0)_$$S^ORU4(48,.CCNT,T,.CCNT)_$$S^ORU4(68,.CCNT,REQX,.CCNT)_$$S^ORU4(78,.CCNT,X,.CCNT)
- End DoDot:2
- End DoDot:1
- +153 KILL ^TMP("ORTMP",$JOB)
- +154 ;Transfused Units
- +155 DO LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM)
- DO LN
- +156 DO TRAN^ORWLR2
- +157 QUIT
- CAN(OROOT,COL) ;Take data from OROOT and build ^TMP("ORCAN",$J)
- +1 NEW START,STOP,INPUT,OUTPUT,CCNT,CNT,WORD,ORX,NEX,CJ,CTR,ORX,ICNT
- +2 DO SPACE(OROOT)
- +3 SET CCNT=1
- SET CNT=$SELECT($ORDER(^TMP("ORCAN",$JOB,0)):$ORDER(^TMP("ORCAN",$JOB,99999999),-1),1:0)
- +4 SET OUTPUT=""
- SET ORK=3
- +5 FOR
- SET ORK=$ORDER(@OROOT@(ORK))
- if 'ORK
- QUIT
- SET X=@OROOT@(ORK)
- Begin DoDot:1
- +6 IF ORK=4
- SET CNT=CNT+1
- SET ^TMP("ORCAN",$JOB,CNT,0)=$$S^ORU4(1,.CCNT,CFAG,.CCNT)
- +7 SET INPUT=OUTPUT_X
- SET START=$SELECT($EXTRACT(INPUT)=" ":2,1:1)
- SET OUTPUT=""
- SET STOP=$LENGTH(INPUT," ")
- +8 IF $LENGTH(INPUT)
- FOR ICNT=START:1:STOP
- SET WORD=$PIECE(INPUT," ",ICNT)
- Begin DoDot:2
- +9 IF $LENGTH(WORD)<1
- IF $LENGTH(OUTPUT)
- SET CNT=CNT+1
- SET ^TMP("ORCAN",$JOB,CNT,0)=$$S^ORU4(1,.CCNT,OUTPUT,.CCNT)
- SET OUTPUT=""
- QUIT
- +10 IF ICNT=$LENGTH(INPUT," ")
- IF +$ORDER(@OROOT@(ORK))<1
- IF '$LENGTH($PIECE(INPUT," ",ICNT+1))
- IF $LENGTH(OUTPUT)
- Begin DoDot:3
- +11 SET OUTPUT=$SELECT($LENGTH(OUTPUT):OUTPUT_" "_WORD,1:WORD)
- SET CNT=CNT+1
- SET ^TMP("ORCAN",$JOB,CNT,0)=$$S^ORU4(1,.CCNT,OUTPUT,.CCNT)
- SET OUTPUT=""
- End DoDot:3
- QUIT
- +12 IF $LENGTH(WORD)>COL
- Begin DoDot:3
- +13 IF $LENGTH(WORD," ")=1
- SET CNT=CNT+1
- SET ^TMP("ORCAN",$JOB,CNT,0)=$$S^ORU4(1,.CCNT,WORD,.CCNT)
- QUIT
- +14 FOR CJ=1:COL
- SET OUTPUT=$EXTRACT(WORD,CJ,CJ+99)
- if '$LENGTH(OUTPUT)
- QUIT
- SET CNT=CNT+1
- SET ^TMP("ORCAN",$JOB,CNT,0)=$$S^ORU4(1,.CCNT,OUTPUT,.CCNT)
- End DoDot:3
- SET OUTPUT=""
- QUIT
- +15 IF $LENGTH(OUTPUT)+$LENGTH(WORD)>COL
- SET CNT=CNT+1
- SET ^TMP("ORCAN",$JOB,CNT,0)=$$S^ORU4(1,.CCNT,OUTPUT,.CCNT)
- SET OUTPUT=""
- Begin DoDot:3
- +16 IF $LENGTH(WORD)>COL
- Begin DoDot:4
- +17 IF $LENGTH(WORD," ")=1
- SET CNT=CNT+1
- SET ^TMP("ORCAN",$JOB,CNT,0)=$$S^ORU4(1,.CCNT,WORD,.CCNT)
- QUIT
- +18 FOR CJ=1:COL
- SET OUTPUT=$EXTRACT(WORD,CJ,CJ+99)
- if '$LENGTH(OUTPUT)
- QUIT
- SET CNT=CNT+1
- SET ^TMP("ORCAN",$JOB,CNT,0)=$$S^ORU4(1,.CCNT,OUTPUT,.CCNT)
- +19 SET OUTPUT=""
- End DoDot:4
- +20 IF '$TEST
- SET OUTPUT=OUTPUT_$SELECT($LENGTH(OUTPUT):" ",1:"")_WORD
- Begin DoDot:4
- +21 IF ICNT=$LENGTH(INPUT," ")
- Begin DoDot:5
- +22 IF +$ORDER(@OROOT@(ORK))<1
- SET CNT=CNT+1
- SET ^TMP("ORCAN",$JOB,CNT,0)=$$S^ORU4(1,.CCNT,OUTPUT,.CCNT)
- SET OUTPUT=""
- QUIT
- End DoDot:5
- End DoDot:4
- End DoDot:3
- QUIT
- +23 SET OUTPUT=$SELECT($LENGTH(OUTPUT):OUTPUT_" "_WORD,1:WORD)
- +24 IF $LENGTH(OUTPUT)>COL
- SET CNT=CNT+1
- SET ^TMP("ORCAN",$JOB,CNT,0)=$$S^ORU4(1,.CCNT,OUTPUT,.CCNT)
- SET OUTPUT=""
- +25 IF ICNT=$LENGTH(INPUT," ")
- Begin DoDot:3
- +26 IF +$ORDER(@OROOT@(ORK))<1
- SET CNT=CNT+1
- SET ^TMP("ORCAN",$JOB,CNT,0)=$$S^ORU4(1,.CCNT,OUTPUT,.CCNT)
- SET OUTPUT=""
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +27 QUIT
- SPACE(OROOT) ;Move Trailing spaces to next line
- +1 NEW ORI,CTR,X
- +2 SET ORI=0
- +3 FOR
- SET ORI=$ORDER(@OROOT@(ORI))
- if 'ORI
- QUIT
- Begin DoDot:1
- +4 ;trailing spaces removed
- SET X=$REVERSE(@OROOT@(ORI))
- SET CTR=0
- FOR
- if $EXTRACT(X)=" "
- SET X=$EXTRACT(X,2,999)
- SET CTR=CTR+1
- if $EXTRACT(X)'=" "
- QUIT
- if '$LENGTH(X)
- QUIT
- +5 ;move spaces to front of next line
- IF CTR
- SET @OROOT@(ORI)=$REVERSE(X)
- IF $ORDER(@OROOT@(ORI))
- SET NEX=$ORDER(@OROOT@(ORI))
- SET ORX(NEX)=$EXTRACT(" ",1,CTR)_ORX(NEX)
- End DoDot:1
- +6 QUIT
- LN ;Increment counts
- +1 SET GCNT=GCNT+1
- SET CCNT=1
- +2 QUIT
- TRIM(X) ;Trim leading and trailing spaces
- +1 ;trail
- SET X=$REVERSE(X)
- FOR
- if $EXTRACT(X)=" "
- SET X=$EXTRACT(X,2,999)
- if $EXTRACT(X)'=" "
- QUIT
- if '$LENGTH(X)
- QUIT
- +2 ;lead
- SET X=$REVERSE(X)
- FOR
- if $EXTRACT(X)=" "
- SET X=$EXTRACT(X,2,999)
- if $EXTRACT(X)'=" "
- QUIT
- if '$LENGTH(X)
- QUIT
- +3 QUIT X