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 Dec 13, 2024@02:36:38 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
