- ORWLR4 ; slc/dcm - VBEC Blood Bank Report cont. ;1/15/09 06:56
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**309,332**;Dec 17, 1997;Build 44
- SPEC ;Specimen Tests (cont.) from ORWLR3
- D HORZ
- Q
- HORZ ;Horizontal display of results
- Q:'$O(^TMP("VBDATA",$J,"SPECIMEN",0))
- K ^TMP("ORTMP",$J),^TMP("ORCOM",$J)
- N SCOL,ALPHA,ORI,ORJ,TST,ORT,CI,CJ,CX,CY,CZ,X,Y,ORY,ORAY,CNT,IDT,ID,ORX,ORCL,CNTR,BUMP,CNUM,ORTM,COM
- N C,I,ORCOL,ORCNT,ORINIT,ORNAM,ORNAME,C1,C2,C3,C4,C6,C8,LINE,FRONT,COMSP,ORDIV,ARRAY
- K ^TMP("ORTMP",$J)
- F ORI=1:1 S X=$P($T(TXT+ORI),";",3) Q:X="" S ORAY(X)=ORI
- S SCOL=19,ORI="",BUMP=0,CNUM="",CFAG="",ALPHA=0,ORTM=$S(ALPHA:96,1:0),C=1,ORINIT="5,5,5,6,7,6,7,6,7" ;Change Alpha to 1 for Alpha comment flag
- F I=3,3,3,5,5,4,5,5,5,0,8 S C=C+1,ORCOL(C)=I ;Initialize column size
- F S ORI=$O(^TMP("VBDATA",$J,"SPECIMEN",ORI),-1) Q:ORI="" S ID=^(ORI) I $L($P(ID,"^",8)),$L($P(ID,"^",5)) D
- . ; ID=CPRS Order#^Division^Tech ID^Test Name^Print Name^Requestor ID^Result^Date/time
- . S IDT=9999999-$P(ID,"^",8)
- . I $P(ID,"^",7)="No Agglutination" S $P(ID,"^",7)="0" ; Translate result: "No Agg..." to 0 (zero)
- . I '$D(^TMP("ORTMP",$J,IDT)) S ^(IDT)=ORI
- . D F4^XUAF4($$STRIP^XLFSTR($P(ID,"^",2)," "),.ARRAY,"","")
- . S ORDIV=$S($G(ARRAY("NAME"))]"":$G(ARRAY("NAME")),1:"Unknown")
- . S $P(^TMP("ORTMP",$J,IDT),"^",12)=$S($P(ID,"^",2)&'$D(ORPRTING):ORDIV,1:$P(ID,"^",2))
- . I $D(ORAY($P(ID,"^",5))) S $P(^TMP("ORTMP",$J,IDT),"^",ORAY($P(ID,"^",5))+1)=$P(ID,"^",7),^(IDT,"IFN",ORI)=$P(ID,"^",5)
- . I $O(^TMP("VBDATA",$J,"SPECIMEN",ORI,3))>3 D ;Flag canned comment
- .. S CNTR=$S($O(^TMP("ORCOM",$J,99999999),-1):$O(^(99999999),-1),1:0),BUMP=0,OR4=$G(^TMP("VBDATA",$J,"SPECIMEN",ORI,4))
- .. S ORK="" F S ORK=$O(^TMP("ORCOM",$J,ORK)) Q:'ORK I ^(ORK)=OR4 S BUMP=ORK Q
- .. I BUMP S CNUM=$S(ALPHA:$C(BUMP+96),1:BUMP),CFAG=$S($L(CFAG)&(CFAG'[CNUM):CFAG_",("_CNUM_")",1:"("_CNUM_")"),$P(^TMP("ORTMP",$J,IDT),"^",11)=CFAG Q
- .. I $L(OR4) S CNTR=CNTR+1,^TMP("ORCOM",$J,CNTR)=^TMP("VBDATA",$J,"SPECIMEN",ORI,4)
- .. S ORTM=ORTM+1,CNUM=$S(ALPHA:$C(ORTM),1:ORTM),CFAG=$S($L(CFAG)&(CFAG'[CNUM):CFAG_",("_CNUM_")",1:"("_CNUM_")"),$P(^TMP("ORTMP",$J,IDT),"^",11)=CFAG
- . D:'$G(BUMP) CAN^ORWLR3("^TMP(""VBDATA"",$J,""SPECIMEN"",ORI)",79)
- S ORI="" F S ORI=$O(^TMP("ORTMP",$J,ORI)) Q:ORI="" S X=^(ORI) F I=2:1:10 S:$L($P(X,"^",I))>ORCOL(I) ORCOL(I)=($L($P(X,"^",I)))
- S ORCNT=SCOL+$L(CFAG),ORCL="",ORI="",$P(ORCL,";")=ORCNT+1
- F S ORI=$O(ORCOL(ORI)) Q:ORI="" S $P(ORCL,";",ORI)=(ORCOL(ORI)+ORCNT+2),ORCNT=$P(ORCL,";",ORI)
- D LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM),LN
- S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(0,.CCNT,"DIAGNOSTIC TESTS:",.CCNT) D LN
- S C8=$$COL(5,10),C4=$$COL(2,4)
- S X="",$P(X," ",C4)="",I="",$P(I," ",19)="",FRONT=$E(" ",1,$L(CFAG))_I_X
- S I=C8-7\2,X="",$P(X,"-",I)="",Y="|"_X_" DAT "_X_"|",Y=FRONT_Y
- S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(2,.CCNT,Y,.CCNT) D LN
- S C1=$$COL(5,6),C2=$$COL(7,8),C3=$$COL(9,10),LINE=FRONT
- S I=C1-7/2,X="",$P(X,"-",I)="",Y="|"_X_" Poly "_X_"| ",LINE=LINE_Y
- S I=C2-7/2,X="",$P(X,"-",I)="",Y="|"_X_" IgG "_X_"| ",LINE=LINE_Y
- S I=C3-7/2,X="",$P(X,"-",I)="",Y="|"_X_" Comp "_X_"|",LINE=LINE_Y
- S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(2,.CCNT,LINE,.CCNT) D LN
- S I=1,X=$E(" ",1,$L(CFAG))_"Date/Time ",ORY=$E(" ",1,$L(CFAG))_" "
- F ORI="ABO","Rh ","ABS","Test","Intrp","Test ","Intrp","Test","Intrp",$S($D(ORPRTING):"Div #",1:"Division") S I=I+1,X=X_ORI_$E(ORY,1,ORCOL(I)-$L(ORI)+$S(I>3:2,1:1))
- S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(2,.CCNT,X,.CCNT) D LN
- S I=1,X=$E(" ",1,$L(CFAG))_"--------------- "
- F ORI="---","---","---","----","-----","----","-----","----","-----",$S($D(ORPRTING):"-----",1:"--------") S I=I+1,X=X_ORI_$E(ORY,1,ORCOL(I)-$L(ORI)+$S(I>3:2,1:1))
- S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(2,.CCNT,X,.CCNT) D LN
- S ORJ="",COMSP=$S($L(CFAG):7,1:3)
- F S ORJ=$O(^TMP("ORTMP",$J,ORJ)) Q:ORJ="" S ORX=^(ORJ) D
- . S COM=$P(ORX,"^",11)
- . D LN S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(1,.CCNT,COM_$S($L(COM):$E(" ",1,$L(COM)-5),1:" "),.CCNT)
- . S T=9999999-ORJ,ORY=$E(" ",1,$L(CFAG)),T=$$FMTE^XLFDT(T,"5MZ"),T=$S($L(COM):" "_T,1:ORY_T)
- . S ^TMP("ORLRC",$J,GCNT,0)=^TMP("ORLRC",$J,GCNT,0)_$$S^ORU4($L(COM)+1,.CCNT,T,.CCNT) ;,ORCL="28;31;36;41;59;77;95;113;131;149;156"
- . F ORT=1:1:9,11 S ^TMP("ORLRC",$J,GCNT,0)=^TMP("ORLRC",$J,GCNT,0)_$$S^ORU4($S(ORT=11:$P(ORCL,";",ORT)-4,ORT=1:$P(ORCL,";",ORT),ORT=2:$P(ORCL,";",ORT)-1,1:$P(ORCL,";",ORT)-2),.CCNT,$P($P(ORX,"^",2,99),"^",ORT),.CCNT)
- . S ORI="",ORNAME="" F S ORI=$O(^TMP("ORTMP",$J,ORJ,"IFN",ORI)) Q:ORI="" S ORNAM=^(ORI) D
- .. F I=1:1 S X=$P($T(TXT+I),";",3) Q:X="" I X=ORNAM S ORNAME=$P($T(TXT+I),";",4) Q
- .. S ORK="",CZ="" F S ORK=$O(^TMP("VBDATA",$J,"SPECIMEN",ORI,ORK)) Q:'ORK S CX=CZ_^(ORK) I $L(CX) D
- ... I ORK>3 Q
- ... S CZ="" F CI=1:1:$L(CX," ") S CY=$P(CX," ",CI) D
- .... I $L(CY)>52 D S CZ="" Q
- ..... F CJ=1:52 S CZ=$E(CY,CJ,CJ+79) Q:'$L(CZ) D LN S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(COMSP,.CCNT,"Comment ("_ORNAME_"): "_CZ,.CCNT)
- .... I $L(CZ)+$L(CY)>52 D LN S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(COMSP,.CCNT,"Comment ("_ORNAME_"): "_CZ,.CCNT),CZ="" D Q
- ..... I $L(CY)>52 D
- ...... F CJ=1:52 S CZ=$E(CY,CJ,CJ+79) Q:'$L(CZ) D LN S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(COMSP,.CCNT,"Comment ("_ORNAME_"): "_CZ,.CCNT)
- ...... S CZ=""
- ..... E S CZ=CY D
- ...... I CI=$L(CX," ") D LN S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(COMSP,.CCNT,"Comment ("_ORNAME_"): "_CZ,.CCNT),CZ=""
- .... S CZ=$S($L(CZ):CZ_" "_CY,1:CY) I $L(CZ)>80 D LN S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(COMSP,.CCNT,"Comment ("_ORNAME_"): "_CZ,.CCNT),CZ=""
- .... I CI=$L(CX," ") D LN S ^TMP("ORLRC",$J,GCNT,0)=$$S^ORU4(COMSP,.CCNT,"Comment ("_ORNAME_"): "_CZ,.CCNT),CZ=""
- I $O(^TMP("ORCAN",$J,0)) D
- . D LN S ^TMP("ORLRC",$J,GCNT,0)=" " D LN S ^TMP("ORLRC",$J,GCNT,0)=" ----- STANDARD COMMENTS FOR DIAGNOSTIC TESTS ABOVE -----"
- . S ORI="" F S ORI=$O(^TMP("ORCAN",$J,ORI)) Q:'ORI I $D(^(ORI,0)) D LN S X=^(0),^TMP("ORLRC",$J,GCNT,0)=X
- K ^TMP("ORTMP",$J),^TMP("ORCAN",$J)
- Q
- COL(A,B) ; Calculate Column Width
- ;A=Beginning column, B=Ending Column, COL=Width of column (depends on length of data)
- Q:'$G(A) 1 Q:'$G(B) 1
- N I,C
- S C=0 F I=A:1:B S C=C+ORCOL(I)+2
- Q C
- LN ;Increment counts
- S GCNT=GCNT+1,CCNT=1
- Q
- TXT ;Test Names passed in from VBECS API - Sequence of this list is significant
- ;;ABO Interp;ABO
- ;;Rh Interp;Rh
- ;;Antibody Screen Interp;ABS
- ;;DAT Poly AHG;DAT Poly
- ;;DAT Poly Interp;Poly INTRP
- ;;DAT IgG AHG;DAT IgG
- ;;DAT IgG Interp;IgG INTRP
- ;;DAT Comp AHG;DAT Comp
- ;;DAT Comp Interp;Comp INTRP
- ;;
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWLR4 6653 printed Dec 13, 2024@02:36:39 Page 2
- ORWLR4 ; slc/dcm - VBEC Blood Bank Report cont. ;1/15/09 06:56
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**309,332**;Dec 17, 1997;Build 44
- SPEC ;Specimen Tests (cont.) from ORWLR3
- +1 DO HORZ
- +2 QUIT
- HORZ ;Horizontal display of results
- +1 if '$ORDER(^TMP("VBDATA",$JOB,"SPECIMEN",0))
- QUIT
- +2 KILL ^TMP("ORTMP",$JOB),^TMP("ORCOM",$JOB)
- +3 NEW SCOL,ALPHA,ORI,ORJ,TST,ORT,CI,CJ,CX,CY,CZ,X,Y,ORY,ORAY,CNT,IDT,ID,ORX,ORCL,CNTR,BUMP,CNUM,ORTM,COM
- +4 NEW C,I,ORCOL,ORCNT,ORINIT,ORNAM,ORNAME,C1,C2,C3,C4,C6,C8,LINE,FRONT,COMSP,ORDIV,ARRAY
- +5 KILL ^TMP("ORTMP",$JOB)
- +6 FOR ORI=1:1
- SET X=$PIECE($TEXT(TXT+ORI),";",3)
- if X=""
- QUIT
- SET ORAY(X)=ORI
- +7 ;Change Alpha to 1 for Alpha comment flag
- SET SCOL=19
- SET ORI=""
- SET BUMP=0
- SET CNUM=""
- SET CFAG=""
- SET ALPHA=0
- SET ORTM=$SELECT(ALPHA:96,1:0)
- SET C=1
- SET ORINIT="5,5,5,6,7,6,7,6,7"
- +8 ;Initialize column size
- FOR I=3,3,3,5,5,4,5,5,5,0,8
- SET C=C+1
- SET ORCOL(C)=I
- +9 FOR
- SET ORI=$ORDER(^TMP("VBDATA",$JOB,"SPECIMEN",ORI),-1)
- if ORI=""
- QUIT
- SET ID=^(ORI)
- IF $LENGTH($PIECE(ID,"^",8))
- IF $LENGTH($PIECE(ID,"^",5))
- Begin DoDot:1
- +10 ; ID=CPRS Order#^Division^Tech ID^Test Name^Print Name^Requestor ID^Result^Date/time
- +11 SET IDT=9999999-$PIECE(ID,"^",8)
- +12 ; Translate result: "No Agg..." to 0 (zero)
- IF $PIECE(ID,"^",7)="No Agglutination"
- SET $PIECE(ID,"^",7)="0"
- +13 IF '$DATA(^TMP("ORTMP",$JOB,IDT))
- SET ^(IDT)=ORI
- +14 DO F4^XUAF4($$STRIP^XLFSTR($PIECE(ID,"^",2)," "),.ARRAY,"","")
- +15 SET ORDIV=$SELECT($GET(ARRAY("NAME"))]"":$GET(ARRAY("NAME")),1:"Unknown")
- +16 SET $PIECE(^TMP("ORTMP",$JOB,IDT),"^",12)=$SELECT($PIECE(ID,"^",2)&'$DATA(ORPRTING):ORDIV,1:$PIECE(ID,"^",2))
- +17 IF $DATA(ORAY($PIECE(ID,"^",5)))
- SET $PIECE(^TMP("ORTMP",$JOB,IDT),"^",ORAY($PIECE(ID,"^",5))+1)=$PIECE(ID,"^",7)
- SET ^(IDT,"IFN",ORI)=$PIECE(ID,"^",5)
- +18 ;Flag canned comment
- IF $ORDER(^TMP("VBDATA",$JOB,"SPECIMEN",ORI,3))>3
- Begin DoDot:2
- +19 SET CNTR=$SELECT($ORDER(^TMP("ORCOM",$JOB,99999999),-1):$ORDER(^(99999999),-1),1:0)
- SET BUMP=0
- SET OR4=$GET(^TMP("VBDATA",$JOB,"SPECIMEN",ORI,4))
- +20 SET ORK=""
- FOR
- SET ORK=$ORDER(^TMP("ORCOM",$JOB,ORK))
- if 'ORK
- QUIT
- IF ^(ORK)=OR4
- SET BUMP=ORK
- QUIT
- +21 IF BUMP
- SET CNUM=$SELECT(ALPHA:$CHAR(BUMP+96),1:BUMP)
- SET CFAG=$SELECT($LENGTH(CFAG)&(CFAG'[CNUM):CFAG_",("_CNUM_")",1:"("_CNUM_")")
- SET $PIECE(^TMP("ORTMP",$JOB,IDT),"^",11)=CFAG
- QUIT
- +22 IF $LENGTH(OR4)
- SET CNTR=CNTR+1
- SET ^TMP("ORCOM",$JOB,CNTR)=^TMP("VBDATA",$JOB,"SPECIMEN",ORI,4)
- +23 SET ORTM=ORTM+1
- SET CNUM=$SELECT(ALPHA:$CHAR(ORTM),1:ORTM)
- SET CFAG=$SELECT($LENGTH(CFAG)&(CFAG'[CNUM):CFAG_",("_CNUM_")",1:"("_CNUM_")")
- SET $PIECE(^TMP("ORTMP",$JOB,IDT),"^",11)=CFAG
- End DoDot:2
- +24 if '$GET(BUMP)
- DO CAN^ORWLR3("^TMP(""VBDATA"",$J,""SPECIMEN"",ORI)",79)
- End DoDot:1
- +25 SET ORI=""
- FOR
- SET ORI=$ORDER(^TMP("ORTMP",$JOB,ORI))
- if ORI=""
- QUIT
- SET X=^(ORI)
- FOR I=2:1:10
- if $LENGTH($PIECE(X,"^",I))>ORCOL(I)
- SET ORCOL(I)=($LENGTH($PIECE(X,"^",I)))
- +26 SET ORCNT=SCOL+$LENGTH(CFAG)
- SET ORCL=""
- SET ORI=""
- SET $PIECE(ORCL,";")=ORCNT+1
- +27 FOR
- SET ORI=$ORDER(ORCOL(ORI))
- if ORI=""
- QUIT
- SET $PIECE(ORCL,";",ORI)=(ORCOL(ORI)+ORCNT+2)
- SET ORCNT=$PIECE(ORCL,";",ORI)
- +28 DO LINE^ORU4("^TMP(""ORLRC"",$J)",GIOM)
- DO LN
- +29 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(0,.CCNT,"DIAGNOSTIC TESTS:",.CCNT)
- DO LN
- +30 SET C8=$$COL(5,10)
- SET C4=$$COL(2,4)
- +31 SET X=""
- SET $PIECE(X," ",C4)=""
- SET I=""
- SET $PIECE(I," ",19)=""
- SET FRONT=$EXTRACT(" ",1,$LENGTH(CFAG))_I_X
- +32 SET I=C8-7\2
- SET X=""
- SET $PIECE(X,"-",I)=""
- SET Y="|"_X_" DAT "_X_"|"
- SET Y=FRONT_Y
- +33 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(2,.CCNT,Y,.CCNT)
- DO LN
- +34 SET C1=$$COL(5,6)
- SET C2=$$COL(7,8)
- SET C3=$$COL(9,10)
- SET LINE=FRONT
- +35 SET I=C1-7/2
- SET X=""
- SET $PIECE(X,"-",I)=""
- SET Y="|"_X_" Poly "_X_"| "
- SET LINE=LINE_Y
- +36 SET I=C2-7/2
- SET X=""
- SET $PIECE(X,"-",I)=""
- SET Y="|"_X_" IgG "_X_"| "
- SET LINE=LINE_Y
- +37 SET I=C3-7/2
- SET X=""
- SET $PIECE(X,"-",I)=""
- SET Y="|"_X_" Comp "_X_"|"
- SET LINE=LINE_Y
- +38 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(2,.CCNT,LINE,.CCNT)
- DO LN
- +39 SET I=1
- SET X=$EXTRACT(" ",1,$LENGTH(CFAG))_"Date/Time "
- SET ORY=$EXTRACT(" ",1,$LENGTH(CFAG))_" "
- +40 FOR ORI="ABO","Rh ","ABS","Test","Intrp","Test ","Intrp","Test","Intrp",$SELECT($DATA(ORPRTING):"Div #",1:"Division")
- SET I=I+1
- SET X=X_ORI_$EXTRACT(ORY,1,ORCOL(I)-$LENGTH(ORI)+$SELECT(I>3:2,1:1))
- +41 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(2,.CCNT,X,.CCNT)
- DO LN
- +42 SET I=1
- SET X=$EXTRACT(" ",1,$LENGTH(CFAG))_"--------------- "
- +43 FOR ORI="---","---","---","----","-----","----","-----","----","-----",$SELECT($DATA(ORPRTING):"-----",1:"--------")
- SET I=I+1
- SET X=X_ORI_$EXTRACT(ORY,1,ORCOL(I)-$LENGTH(ORI)+$SELECT(I>3:2,1:1))
- +44 SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(2,.CCNT,X,.CCNT)
- DO LN
- +45 SET ORJ=""
- SET COMSP=$SELECT($LENGTH(CFAG):7,1:3)
- +46 FOR
- SET ORJ=$ORDER(^TMP("ORTMP",$JOB,ORJ))
- if ORJ=""
- QUIT
- SET ORX=^(ORJ)
- Begin DoDot:1
- +47 SET COM=$PIECE(ORX,"^",11)
- +48 DO LN
- SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(1,.CCNT,COM_$SELECT($LENGTH(COM):$EXTRACT(" ",1,$LENGTH(COM)-5),1:" "),.CCNT)
- +49 SET T=9999999-ORJ
- SET ORY=$EXTRACT(" ",1,$LENGTH(CFAG))
- SET T=$$FMTE^XLFDT(T,"5MZ")
- SET T=$SELECT($LENGTH(COM):" "_T,1:ORY_T)
- +50 ;,ORCL="28;31;36;41;59;77;95;113;131;149;156"
- SET ^TMP("ORLRC",$JOB,GCNT,0)=^TMP("ORLRC",$JOB,GCNT,0)_$$S^ORU4($LENGTH(COM)+1,.CCNT,T,.CCNT)
- +51 FOR ORT=1:1:9,11
- SET ^TMP("ORLRC",$JOB,GCNT,0)=^TMP("ORLRC",$JOB,GCNT,0)_$$S^ORU4($SELECT(ORT=11:$PIECE(ORCL,";",ORT)-4,ORT=1:$PIECE(ORCL,";",ORT),ORT=2:$PIECE(ORCL,";",ORT)-1,1:$PIECE(ORCL,";",ORT)-2),.CCNT,$PIECE($PIECE(ORX,"^",2,99),"^",ORT),.CCN
- T)
- +52 SET ORI=""
- SET ORNAME=""
- FOR
- SET ORI=$ORDER(^TMP("ORTMP",$JOB,ORJ,"IFN",ORI))
- if ORI=""
- QUIT
- SET ORNAM=^(ORI)
- Begin DoDot:2
- +53 FOR I=1:1
- SET X=$PIECE($TEXT(TXT+I),";",3)
- if X=""
- QUIT
- IF X=ORNAM
- SET ORNAME=$PIECE($TEXT(TXT+I),";",4)
- QUIT
- +54 SET ORK=""
- SET CZ=""
- FOR
- SET ORK=$ORDER(^TMP("VBDATA",$JOB,"SPECIMEN",ORI,ORK))
- if 'ORK
- QUIT
- SET CX=CZ_^(ORK)
- IF $LENGTH(CX)
- Begin DoDot:3
- +55 IF ORK>3
- QUIT
- +56 SET CZ=""
- FOR CI=1:1:$LENGTH(CX," ")
- SET CY=$PIECE(CX," ",CI)
- Begin DoDot:4
- +57 IF $LENGTH(CY)>52
- Begin DoDot:5
- +58 FOR CJ=1:52
- SET CZ=$EXTRACT(CY,CJ,CJ+79)
- if '$LENGTH(CZ)
- QUIT
- DO LN
- SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(COMSP,.CCNT,"Comment ("_ORNAME_"): "_CZ,.CCNT)
- End DoDot:5
- SET CZ=""
- QUIT
- +59 IF $LENGTH(CZ)+$LENGTH(CY)>52
- DO LN
- SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(COMSP,.CCNT,"Comment ("_ORNAME_"): "_CZ,.CCNT)
- SET CZ=""
- Begin DoDot:5
- +60 IF $LENGTH(CY)>52
- Begin DoDot:6
- +61 FOR CJ=1:52
- SET CZ=$EXTRACT(CY,CJ,CJ+79)
- if '$LENGTH(CZ)
- QUIT
- DO LN
- SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(COMSP,.CCNT,"Comment ("_ORNAME_"): "_CZ,.CCNT)
- +62 SET CZ=""
- End DoDot:6
- +63 IF '$TEST
- SET CZ=CY
- Begin DoDot:6
- +64 IF CI=$LENGTH(CX," ")
- DO LN
- SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(COMSP,.CCNT,"Comment ("_ORNAME_"): "_CZ,.CCNT)
- SET CZ=""
- End DoDot:6
- End DoDot:5
- QUIT
- +65 SET CZ=$SELECT($LENGTH(CZ):CZ_" "_CY,1:CY)
- IF $LENGTH(CZ)>80
- DO LN
- SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(COMSP,.CCNT,"Comment ("_ORNAME_"): "_CZ,.CCNT)
- SET CZ=""
- +66 IF CI=$LENGTH(CX," ")
- DO LN
- SET ^TMP("ORLRC",$JOB,GCNT,0)=$$S^ORU4(COMSP,.CCNT,"Comment ("_ORNAME_"): "_CZ,.CCNT)
- SET CZ=""
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +67 IF $ORDER(^TMP("ORCAN",$JOB,0))
- Begin DoDot:1
- +68 DO LN
- SET ^TMP("ORLRC",$JOB,GCNT,0)=" "
- DO LN
- SET ^TMP("ORLRC",$JOB,GCNT,0)=" ----- STANDARD COMMENTS FOR DIAGNOSTIC TESTS ABOVE -----"
- +69 SET ORI=""
- FOR
- SET ORI=$ORDER(^TMP("ORCAN",$JOB,ORI))
- if 'ORI
- QUIT
- IF $DATA(^(ORI,0))
- DO LN
- SET X=^(0)
- SET ^TMP("ORLRC",$JOB,GCNT,0)=X
- End DoDot:1
- +70 KILL ^TMP("ORTMP",$JOB),^TMP("ORCAN",$JOB)
- +71 QUIT
- COL(A,B) ; Calculate Column Width
- +1 ;A=Beginning column, B=Ending Column, COL=Width of column (depends on length of data)
- +2 if '$GET(A)
- QUIT 1
- if '$GET(B)
- QUIT 1
- +3 NEW I,C
- +4 SET C=0
- FOR I=A:1:B
- SET C=C+ORCOL(I)+2
- +5 QUIT C
- LN ;Increment counts
- +1 SET GCNT=GCNT+1
- SET CCNT=1
- +2 QUIT
- TXT ;Test Names passed in from VBECS API - Sequence of this list is significant
- +1 ;;ABO Interp;ABO
- +2 ;;Rh Interp;Rh
- +3 ;;Antibody Screen Interp;ABS
- +4 ;;DAT Poly AHG;DAT Poly
- +5 ;;DAT Poly Interp;Poly INTRP
- +6 ;;DAT IgG AHG;DAT IgG
- +7 ;;DAT IgG Interp;IgG INTRP
- +8 ;;DAT Comp AHG;DAT Comp
- +9 ;;DAT Comp Interp;Comp INTRP
- +10 ;;
- +11 QUIT