BLRAG09E ; IHS/MSC/SAT - SUPPORT FOR LABORATORY ACCESSION GUI RPCS ; NOV 14, 2012
;;5.2;IHS LABORATORY;**1031**;NOV 01, 1997;Build 185
;
;support for screen formatted text for manifest display
;
INIT ; Initialize variables
;
S DT=$$DT^XLFDT
S LA7QUIT=0
;
S LA7SCFG(0)=$G(^LAHM(62.9,+LA7SCFG,0))
Q
;
HED ; Header
S LA7PAGE=LA7PAGE+1
S BLRY=0
I +LA7SMST'=4,BLRIOM<132 D WARN
;
S BLRTXT=" "_"Shipping Manifest: "_$P(LA7SM,"^",2)
S BLRTXT=BLRTXT_$$FILL^BLRAGUT(BLRIOM-11-$L(BLRTXT))_" Page: "_LA7PAGE
S BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)=BLRTXT
I +LA7SMST'=4,BLRIOM'<132 D WARN
;
;S BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)=$$FILL^BLRAGUT(BLRIOM-38)_" Page: "_LA7PAGE
S BLRTXT=$$FILL^BLRAGUT(10)_"to Site: "_LA7TSITE
S BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)=BLRTXT_$$FILL^BLRAGUT(39-$L(BLRTXT))_" Printed: "_LA7NOW
S BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)=$$FILL^BLRAGUT(8)_"from Site: "_LA7FSITE
S BLRTXT=""
;
I +LA7SMST=4 S BLRTXT=$$FILL^BLRAGUT(5)_"Date Shipped: "_$P(LA7SDT,"^",2)
E S BLRTXT=$$FILL^BLRAGUT(11)_"Status: "_$P(LA7SMST,"^",2)
S BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)=BLRTXT_$$FILL^BLRAGUT(80-41)_" Ship via: "_LA7SVIA
;
; Print shipping receipt
I $P(LA7SMR,"^",2) D Q
. S BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)=LA7LINE
. I $P(LA7SMR,"^",2)=2 D
. . S BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)=""
. . S BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)="Following Required Information and/or Test Codes Missing"
. . S BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)="" S BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)=""
;
S BLRTXT="Shipping Condition: "_$S(LA7SCOND:$$GET1^DIQ(62.93,LA7SCOND_",",.01),1:"None Specified")
S BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)=BLRTXT_$$FILL^BLRAGUT(10)_" Container: "_$S(LA7SCONT:$$GET1^DIQ(62.91,LA7SCONT_",",.01),1:"None Specified")
;
I LA7SBC D SBC1
S BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)=""
S BLRTXT=$$FILL^BLRAGUT(10)_"Patient Name"
S BLRTXT=BLRTXT_$$FILL^BLRAGUT(40-$L(BLRTXT))_"Patient ID"
S BLRTXT=BLRTXT_$$FILL^BLRAGUT(65-$L(BLRTXT))_"Lab Reference #"
I BLRIOM>131 S BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)=BLRTXT_$$FILL^BLRAGUT(85-$L(BLRTXT))_"Requested By"
E S BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)=BLRTXT
;
S BLRTXT=$$FILL^BLRAGUT(10)_"Date of Birth"
S BLRTXT=BLRTXT_$$FILL^BLRAGUT(40-$L(BLRTXT))_"Sex"
S BLRTXT=BLRTXT_$$FILL^BLRAGUT(65-$L(BLRTXT))_"Specimen UID"
I BLRIOM>131 S BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)=BLRTXT_$$FILL^BLRAGUT(85-$L(BLRTXT))_"Collect Date/Time"
E D
. S BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)=BLRTXT
. S BLRTXT=$$FILL^BLRAGUT(10)_"Requested By"
. S BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)=BLRTXT_$$FILL^BLRAGUT(40-$L(BLRTXT))_"Collect Date/Time"
S BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)=LA7LINE
S BLRTXT=""
Q
;
SH ; Subheader
S BLRTXT="Item: "_LA7ITEM
S BLRTXT=BLRTXT_$$FILL^BLRAGUT(10-$L($E(BLRTXT,1,10)))_PNM
S BLRTXT=BLRTXT_$$FILL^BLRAGUT(40-$L(BLRTXT))_$S(LRDPF=2:$$HRN^AUPNPAT(DFN,DUZ(2)),1:"")
S BLRTXT=BLRTXT_$$FILL^BLRAGUT(65-$L(BLRTXT))_$$GETORDA^LA7VORM1(LA7UID) ;cmi/maw 7/6/2010 ref lab now order number
I BLRIOM>131 S BLRTXT=BLRTXT_$$FILL^BLRAGUT(85-$L(BLRTXT))_$P($G(LA7PROV),"^",2)
S BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)=BLRTXT
S BLRTXT=""
I LA7DC S BLRTXT="Cont'd"
S BLRTXT=BLRTXT_$$FILL^BLRAGUT(10-$L(BLRTXT))_$$FMTE^XLFDT(DOB)
S BLRTXT=BLRTXT_$$FILL^BLRAGUT(40-$L(BLRTXT))_$S(SEX="M":"Male",SEX="F":"Female",SEX="":"Unknown",1:SEX)
S BLRTXT=BLRTXT_$$FILL^BLRAGUT(65-$L(BLRTXT))_LA7UID
I BLRIOM'>131 D
. S BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)=BLRTXT
. S BLRTXT=$$FILL^BLRAGUT(10-$L(BLRTXT))_$$GET1^DIQ(200,$P($G(LA7PROV),"^"),41.99)_"-"_$E($P($G(LA7PROV),"^",2),1,19)
. S BLRTXT=BLRTXT_$$FILL^BLRAGUT(40-$L(BLRTXT))_$S(LA7CDT:$$FMTE^XLFDT(LA7CDT,"1M"),1:LA7CDT) ;cmi/maw 7/6/2010 for NPI
I BLRIOM>131 S BLRTXT=BLRTXT_$$FILL^BLRAGUT(85-$L(BLRTXT))_$S(LA7CDT:$$FMTE^XLFDT(LA7CDT,"1M"),1:LA7CDT)
S BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)=BLRTXT
S BLRTXT=""
I +LA7SMST'=4 D
. D PROV(+$G(LA7PROV))
. I $P($G(LA762801(0)),"^",6) D
. . S X=$$GET1^DIQ(62.91,$P(LA762801(0),"^",6),.01)
. . S BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)=$$FILL^BLRAGUT(10)_"Specimen Container: "_X
;
; Print collection sample if micro
I $G(LA7AA),$P($G(^LRO(68,LA7AA,0)),"^",2)="MI" S BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)=$$FILL^BLRAGUT(10)_"Collection sample: "_$P(LA762(0),"^")
;
S LA7X=$G(^TMP("LA7SMRI",$J,LA7SCOND,LA7SCONT,LA7UID,1))
S BLRTXT=""
I $P(LA7X,"^") D
. S BLRTXT=$$FILL^BLRAGUT(10)_"Patient Height: "_$P(LA7X,"^",2)_" "_$$GET1^DIQ(64.061,+$P(LA7X,"^",3)_",",.01)
I $P(LA7X,"^",4) D
. I $P(LA7X,"^") S BLRTXT=BLRTXT_$$FILL^BLRAGUT(39-$L(BLRTXT))
. E S BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)=BLRTXT S BLRTXT=BLRTXT_$$FILL^BLRAGUT(10)
. S BLRTXT=BLRTXT_"Patient Weight: "_$P(LA7X,"^",5)_" "_$$GET1^DIQ(64.061,+$P(LA7X,"^",6)_",",.01)
S:BLRTXT'="" BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)=BLRTXT
S BLRTXT=""
;
S LA7X=$G(^TMP("LA7SMRI",$J,LA7SCOND,LA7SCONT,LA7UID,2))
S BLRTXT=""
I $P(LA7X,"^") D
. S BLRTXT=$$FILL^BLRAGUT(10)_"Collection Volume: "_$P(LA7X,"^",2)_" "_$$GET1^DIQ(64.061,+$P(LA7X,"^",3)_",",.01)
I $P(LA7X,"^",8) D
. I $P(LA7X,"^") S BLRTXT=BLRTXT_$$FILL^BLRAGUT(39-$L(BLRTXT))
. E S BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)=BLRTXT S BLRTXT=$$FILL^BLRAGUT(10)
. S BLRTXT=BLRTXT_"Collection Weight: "_$P(LA7X,"^",9)_" "_$$GET1^DIQ(64.061,+$P(LA7X,"^",10)_",",.01)
S:BLRTXT'="" BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)=BLRTXT
I $P(LA7X,"^",4) D
. S BLRTXT=$$FILL^BLRAGUT(10)_"Collection End Date/Time: "_$$FMTE^XLFDT($P(LA7X,"^",5),"1M")
. S BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)=BLRTXT_" (Duration: "_$P(LA7X,"^",6)_" "_$$GET1^DIQ(64.061,+$P(LA7X,"^",7)_",",.01)_")"
;
I LA7SBC D SBC2
S LA7DC=0
Q
;
CMT ; Print comments on manifest
N LA7I
F LA7I=1:1:LA7CMT D Q:LA7EXIT
. I (BLRY+4)>BLRIOSL D Q:LA7EXIT
. . I LA7PAGE S BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)="" D WARN
. . D HED
. S BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)=$$FILL^BLRAGUT(10)_LA7CMT(LA7I,0)
Q
;
OCMT(UID) ;now check here for order comment
N ORD,ORDI,ORDD,ORDA,ORDB
S ORD=$$GETORDA^LA7VORM1(UID)
Q:'ORD
S ORDD=$O(^LRO(69,"C",ORD,0))
Q:'ORDD
S ORDI=0 F S ORDI=$O(^LRO(69,ORDD,1,ORDI)) Q:'ORDI D
. S ORDA=0 F S ORDA=$O(^LRO(69,ORDD,1,ORDI,2,ORDA)) Q:'ORDA D
.. Q:$G(^LRO(69,ORDD,1,ORDI,2,ORDA,.3))'=UID
.. S ORDB=0 F S ORDB=$O(^LRO(69,ORDD,1,ORDI,2,ORDA,1,ORDB)) Q:'ORDB D
... S BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)=$$FILL^BLRAGUT(10)_$G(^LRO(69,ORDD,1,ORDI,2,ORDA,1,ORDB,0))
Q
;
PROV(LA7OP) ; Print ordering provider contact on working copy
; Call with LA7OP = provider's file #200 ien
;
N LRERR,X,Y
I LA7OP D GETS^DIQ(200,LA7OP_",",".132;.137;.138","E","LA7OP(LA7OP)","LRERR")
I '$D(LA7OP(LA7OP)) Q
S X="Requestor's "
S BLRTXT=""
I LA7OP(LA7OP,200,LA7OP_",",.132,"E")'="" D
. S BLRTXT=$$FILL^BLRAGUT(10)_X_"Phone: "_LA7OP(LA7OP,200,LA7OP_",",.132,"E")
. S X=""
I LA7OP(LA7OP,200,LA7OP_",",.137,"E")'="" D
. S Y=0
. I X="" S Y=$L(LA7OP(LA7OP,200,LA7OP_",",.137,"E"))+$L(BLRTX)+16
. I Y>BLRIOM!(X'="") S BLRI=BLRI+1,BLRY=BLRY+1,BLRTXT(BLRI)=BLRTXT,BLRTXT=$$FILL^BLRAGUT(10)
. E S X=" "_X
. S BLRTXT=BLRTXT_X_"Voice Pager: "_LA7OP(LA7OP,200,LA7OP_",",.137,"E")
. S X=""
I LA7OP(LA7OP,200,LA7OP_",",.138,"E")'="" D
. S Y=0
. I X="" S Y=$L(LA7OP(LA7OP,200,LA7OP_",",.138,"E"))+$L(BLRTXT)+18
. I Y>BLRIOM!(X'="") S BLRI=BLRI+1,BLRY=BLRY+1,BLRTXT(BLRI)=BLRTXT,BLRTXT=$$FILL^BLRAGUT(10)
. E S X=" "_X
. S BLRTXT=BLRTXT_X_"Digital Pager: "_LA7OP(LA7OP,200,LA7OP_",",.138,"E")
. S X=""
S:BLRTXT'="" BLRI=BLRI+1,BLRY=BLRY+1,BLRTXT(BLRI)=BLRTXT
;
I X="" S BLRI=BLRI+1,BLRY=BLRY+1,BLRTXT(BLRI)=""
Q
;
WARN ; Write warning for work copy.
S BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)="*** DO NOT USE FOR SHIPPING DOCUMENT - WORK COPY ONLY ***"
Q
;
SBC1 ; Site bar codes
;
; Print "SM" bar code
; Calculate/append LPC to barcode.
I $G(LA7SM("BARCODE"))="" D
. N LA7X,X,Y
. I LA7SBC=1 D
. . S LA7X="STX^SITE^"_LA7FSITE(99)_"^"_$P($G(LA7SDT),"^")_"^"_$P(LA7SM,"^",2)_"^ETX"
. I LA7SBC=2 D
. .S LA7X="SITE^"_LA7FSITE(99)_"^"_$P($G(LA7SDT),"^")_"^"_$P(LA7SM,"^",2)_"^"
. S X=LA7X X ^%ZOSF("LPC") S LA7SM("LPC")=Y,LA7SM("BARCODE")=LA7X_Y
;
S BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)=$$FILL^BLRAGUT(17)_"SM: "_$$BC128^LA7SBC(LA7SM("BARCODE"),1,60,"","",2)
S BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)=""
;
Q
;
SBC2 ; Patient bar codes
;
N LA7SDATA
;
; Print "PD" bar code
I LA7SBC=1 D
. S LA7SDATA="STX^PD^"_SSN(2)_"^"_LA7FSITE(99)_"^"_LA7UID_"^"_$G(SEX)_"^"_LA7CDT_"^ETX"_$G(LA7SM("LPC"))
;
I LA7SBC=2 D
. S LA7SDATA="PD^"_SSN(2)_"^"_LA7FSITE(99)_"^"_LA7UID_"^"_LA7CDT_"^"_$G(LA7SM("LPC"))
;
S BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)=""
S BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)=$$FILL^BLRAGUT(17)_"PD: "_$$BC128^LA7SBC(LA7SDATA,1,60,"","",2)
S BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)=""
S BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)=$$FILL^BLRAGUT(10)_$E(LA7LINE,1,69)
;
; Print "PD1" bar code
I LA7SBC=1 D
. S LA7SDATA="STX^PD1^"_SSN(2)_"^"_PNM_"^"_DOB_"^ETX"_$G(LA7SM("LPC"))
I LA7SBC=2 D
. S LA7SDATA="PD1^"_SSN(2)_"^"_PNM_"^"_DOB_"^"_SEX_"^"_$G(LA7SM("LPC"))
;
S BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)=$$FILL^BLRAGUT($S(BLRIOM<131:18,1:50))_"PD1: "_$$BC128^LA7SBC(LA7SDATA,1,60,"","",2)
S BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)=""
;
Q
BLRAG09E ; IHS/MSC/SAT - SUPPORT FOR LABORATORY ACCESSION GUI RPCS ; NOV 14, 2012
+1 ;;5.2;IHS LABORATORY;**1031**;NOV 01, 1997;Build 185
+2 ;
+3 ;support for screen formatted text for manifest display
+4 ;
INIT ; Initialize variables
+1 ;
+2 SET DT=$$DT^XLFDT
+3 SET LA7QUIT=0
+4 ;
+5 SET LA7SCFG(0)=$GET(^LAHM(62.9,+LA7SCFG,0))
+6 QUIT
+7 ;
HED ; Header
+1 SET LA7PAGE=LA7PAGE+1
+2 SET BLRY=0
+3 IF +LA7SMST'=4
IF BLRIOM<132
DO WARN
+4 ;
+5 SET BLRTXT=" "_"Shipping Manifest: "_$PIECE(LA7SM,"^",2)
+6 SET BLRTXT=BLRTXT_$$FILL^BLRAGUT(BLRIOM-11-$LENGTH(BLRTXT))_" Page: "_LA7PAGE
+7 SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=BLRTXT
+8 IF +LA7SMST'=4
IF BLRIOM'<132
DO WARN
+9 ;
+10 ;S BLRI=BLRI+1,BLRY=BLRY+1 S BLRTXT(BLRI)=$$FILL^BLRAGUT(BLRIOM-38)_" Page: "_LA7PAGE
+11 SET BLRTXT=$$FILL^BLRAGUT(10)_"to Site: "_LA7TSITE
+12 SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=BLRTXT_$$FILL^BLRAGUT(39-$LENGTH(BLRTXT))_" Printed: "_LA7NOW
+13 SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=$$FILL^BLRAGUT(8)_"from Site: "_LA7FSITE
+14 SET BLRTXT=""
+15 ;
+16 IF +LA7SMST=4
SET BLRTXT=$$FILL^BLRAGUT(5)_"Date Shipped: "_$PIECE(LA7SDT,"^",2)
+17 IF '$TEST
SET BLRTXT=$$FILL^BLRAGUT(11)_"Status: "_$PIECE(LA7SMST,"^",2)
+18 SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=BLRTXT_$$FILL^BLRAGUT(80-41)_" Ship via: "_LA7SVIA
+19 ;
+20 ; Print shipping receipt
+21 IF $PIECE(LA7SMR,"^",2)
Begin DoDot:1
+22 SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=LA7LINE
+23 IF $PIECE(LA7SMR,"^",2)=2
Begin DoDot:2
+24 SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=""
+25 SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)="Following Required Information and/or Test Codes Missing"
+26 SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=""
SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=""
End DoDot:2
End DoDot:1
QUIT
+27 ;
+28 SET BLRTXT="Shipping Condition: "_$SELECT(LA7SCOND:$$GET1^DIQ(62.93,LA7SCOND_",",.01),1:"None Specified")
+29 SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=BLRTXT_$$FILL^BLRAGUT(10)_" Container: "_$SELECT(LA7SCONT:$$GET1^DIQ(62.91,LA7SCONT_",",.01),1:"None Specified")
+30 ;
+31 IF LA7SBC
DO SBC1
+32 SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=""
+33 SET BLRTXT=$$FILL^BLRAGUT(10)_"Patient Name"
+34 SET BLRTXT=BLRTXT_$$FILL^BLRAGUT(40-$LENGTH(BLRTXT))_"Patient ID"
+35 SET BLRTXT=BLRTXT_$$FILL^BLRAGUT(65-$LENGTH(BLRTXT))_"Lab Reference #"
+36 IF BLRIOM>131
SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=BLRTXT_$$FILL^BLRAGUT(85-$LENGTH(BLRTXT))_"Requested By"
+37 IF '$TEST
SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=BLRTXT
+38 ;
+39 SET BLRTXT=$$FILL^BLRAGUT(10)_"Date of Birth"
+40 SET BLRTXT=BLRTXT_$$FILL^BLRAGUT(40-$LENGTH(BLRTXT))_"Sex"
+41 SET BLRTXT=BLRTXT_$$FILL^BLRAGUT(65-$LENGTH(BLRTXT))_"Specimen UID"
+42 IF BLRIOM>131
SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=BLRTXT_$$FILL^BLRAGUT(85-$LENGTH(BLRTXT))_"Collect Date/Time"
+43 IF '$TEST
Begin DoDot:1
+44 SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=BLRTXT
+45 SET BLRTXT=$$FILL^BLRAGUT(10)_"Requested By"
+46 SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=BLRTXT_$$FILL^BLRAGUT(40-$LENGTH(BLRTXT))_"Collect Date/Time"
End DoDot:1
+47 SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=LA7LINE
+48 SET BLRTXT=""
+49 QUIT
+50 ;
SH ; Subheader
+1 SET BLRTXT="Item: "_LA7ITEM
+2 SET BLRTXT=BLRTXT_$$FILL^BLRAGUT(10-$LENGTH($EXTRACT(BLRTXT,1,10)))_PNM
+3 SET BLRTXT=BLRTXT_$$FILL^BLRAGUT(40-$LENGTH(BLRTXT))_$SELECT(LRDPF=2:$$HRN^AUPNPAT(DFN,DUZ(2)),1:"")
+4 ;cmi/maw 7/6/2010 ref lab now order number
SET BLRTXT=BLRTXT_$$FILL^BLRAGUT(65-$LENGTH(BLRTXT))_$$GETORDA^LA7VORM1(LA7UID)
+5 IF BLRIOM>131
SET BLRTXT=BLRTXT_$$FILL^BLRAGUT(85-$LENGTH(BLRTXT))_$PIECE($GET(LA7PROV),"^",2)
+6 SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=BLRTXT
+7 SET BLRTXT=""
+8 IF LA7DC
SET BLRTXT="Cont'd"
+9 SET BLRTXT=BLRTXT_$$FILL^BLRAGUT(10-$LENGTH(BLRTXT))_$$FMTE^XLFDT(DOB)
+10 SET BLRTXT=BLRTXT_$$FILL^BLRAGUT(40-$LENGTH(BLRTXT))_$SELECT(SEX="M":"Male",SEX="F":"Female",SEX="":"Unknown",1:SEX)
+11 SET BLRTXT=BLRTXT_$$FILL^BLRAGUT(65-$LENGTH(BLRTXT))_LA7UID
+12 IF BLRIOM'>131
Begin DoDot:1
+13 SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=BLRTXT
+14 SET BLRTXT=$$FILL^BLRAGUT(10-$LENGTH(BLRTXT))_$$GET1^DIQ(200,$PIECE($GET(LA7PROV),"^"),41.99)_"-"_$EXTRACT($PIECE($GET(LA7PROV),"^",2),1,19)
+15 ;cmi/maw 7/6/2010 for NPI
SET BLRTXT=BLRTXT_$$FILL^BLRAGUT(40-$LENGTH(BLRTXT))_$SELECT(LA7CDT:$$FMTE^XLFDT(LA7CDT,"1M"),1:LA7CDT)
End DoDot:1
+16 IF BLRIOM>131
SET BLRTXT=BLRTXT_$$FILL^BLRAGUT(85-$LENGTH(BLRTXT))_$SELECT(LA7CDT:$$FMTE^XLFDT(LA7CDT,"1M"),1:LA7CDT)
+17 SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=BLRTXT
+18 SET BLRTXT=""
+19 IF +LA7SMST'=4
Begin DoDot:1
+20 DO PROV(+$GET(LA7PROV))
+21 IF $PIECE($GET(LA762801(0)),"^",6)
Begin DoDot:2
+22 SET X=$$GET1^DIQ(62.91,$PIECE(LA762801(0),"^",6),.01)
+23 SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=$$FILL^BLRAGUT(10)_"Specimen Container: "_X
End DoDot:2
End DoDot:1
+24 ;
+25 ; Print collection sample if micro
+26 IF $GET(LA7AA)
IF $PIECE($GET(^LRO(68,LA7AA,0)),"^",2)="MI"
SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=$$FILL^BLRAGUT(10)_"Collection sample: "_$PIECE(LA762(0),"^")
+27 ;
+28 SET LA7X=$GET(^TMP("LA7SMRI",$JOB,LA7SCOND,LA7SCONT,LA7UID,1))
+29 SET BLRTXT=""
+30 IF $PIECE(LA7X,"^")
Begin DoDot:1
+31 SET BLRTXT=$$FILL^BLRAGUT(10)_"Patient Height: "_$PIECE(LA7X,"^",2)_" "_$$GET1^DIQ(64.061,+$PIECE(LA7X,"^",3)_",",.01)
End DoDot:1
+32 IF $PIECE(LA7X,"^",4)
Begin DoDot:1
+33 IF $PIECE(LA7X,"^")
SET BLRTXT=BLRTXT_$$FILL^BLRAGUT(39-$LENGTH(BLRTXT))
+34 IF '$TEST
SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=BLRTXT
SET BLRTXT=BLRTXT_$$FILL^BLRAGUT(10)
+35 SET BLRTXT=BLRTXT_"Patient Weight: "_$PIECE(LA7X,"^",5)_" "_$$GET1^DIQ(64.061,+$PIECE(LA7X,"^",6)_",",.01)
End DoDot:1
+36 IF BLRTXT'=""
SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=BLRTXT
+37 SET BLRTXT=""
+38 ;
+39 SET LA7X=$GET(^TMP("LA7SMRI",$JOB,LA7SCOND,LA7SCONT,LA7UID,2))
+40 SET BLRTXT=""
+41 IF $PIECE(LA7X,"^")
Begin DoDot:1
+42 SET BLRTXT=$$FILL^BLRAGUT(10)_"Collection Volume: "_$PIECE(LA7X,"^",2)_" "_$$GET1^DIQ(64.061,+$PIECE(LA7X,"^",3)_",",.01)
End DoDot:1
+43 IF $PIECE(LA7X,"^",8)
Begin DoDot:1
+44 IF $PIECE(LA7X,"^")
SET BLRTXT=BLRTXT_$$FILL^BLRAGUT(39-$LENGTH(BLRTXT))
+45 IF '$TEST
SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=BLRTXT
SET BLRTXT=$$FILL^BLRAGUT(10)
+46 SET BLRTXT=BLRTXT_"Collection Weight: "_$PIECE(LA7X,"^",9)_" "_$$GET1^DIQ(64.061,+$PIECE(LA7X,"^",10)_",",.01)
End DoDot:1
+47 IF BLRTXT'=""
SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=BLRTXT
+48 IF $PIECE(LA7X,"^",4)
Begin DoDot:1
+49 SET BLRTXT=$$FILL^BLRAGUT(10)_"Collection End Date/Time: "_$$FMTE^XLFDT($PIECE(LA7X,"^",5),"1M")
+50 SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=BLRTXT_" (Duration: "_$PIECE(LA7X,"^",6)_" "_$$GET1^DIQ(64.061,+$PIECE(LA7X,"^",7)_",",.01)_")"
End DoDot:1
+51 ;
+52 IF LA7SBC
DO SBC2
+53 SET LA7DC=0
+54 QUIT
+55 ;
CMT ; Print comments on manifest
+1 NEW LA7I
+2 FOR LA7I=1:1:LA7CMT
Begin DoDot:1
+3 IF (BLRY+4)>BLRIOSL
Begin DoDot:2
+4 IF LA7PAGE
SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=""
DO WARN
+5 DO HED
End DoDot:2
IF LA7EXIT
QUIT
+6 SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=$$FILL^BLRAGUT(10)_LA7CMT(LA7I,0)
End DoDot:1
IF LA7EXIT
QUIT
+7 QUIT
+8 ;
OCMT(UID) ;now check here for order comment
+1 NEW ORD,ORDI,ORDD,ORDA,ORDB
+2 SET ORD=$$GETORDA^LA7VORM1(UID)
+3 IF 'ORD
QUIT
+4 SET ORDD=$ORDER(^LRO(69,"C",ORD,0))
+5 IF 'ORDD
QUIT
+6 SET ORDI=0
FOR
SET ORDI=$ORDER(^LRO(69,ORDD,1,ORDI))
IF 'ORDI
QUIT
Begin DoDot:1
+7 SET ORDA=0
FOR
SET ORDA=$ORDER(^LRO(69,ORDD,1,ORDI,2,ORDA))
IF 'ORDA
QUIT
Begin DoDot:2
+8 IF $GET(^LRO(69,ORDD,1,ORDI,2,ORDA,.3))'=UID
QUIT
+9 SET ORDB=0
FOR
SET ORDB=$ORDER(^LRO(69,ORDD,1,ORDI,2,ORDA,1,ORDB))
IF 'ORDB
QUIT
Begin DoDot:3
+10 SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=$$FILL^BLRAGUT(10)_$GET(^LRO(69,ORDD,1,ORDI,2,ORDA,1,ORDB,0))
End DoDot:3
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
PROV(LA7OP) ; Print ordering provider contact on working copy
+1 ; Call with LA7OP = provider's file #200 ien
+2 ;
+3 NEW LRERR,X,Y
+4 IF LA7OP
DO GETS^DIQ(200,LA7OP_",",".132;.137;.138","E","LA7OP(LA7OP)","LRERR")
+5 IF '$DATA(LA7OP(LA7OP))
QUIT
+6 SET X="Requestor's "
+7 SET BLRTXT=""
+8 IF LA7OP(LA7OP,200,LA7OP_",",.132,"E")'=""
Begin DoDot:1
+9 SET BLRTXT=$$FILL^BLRAGUT(10)_X_"Phone: "_LA7OP(LA7OP,200,LA7OP_",",.132,"E")
+10 SET X=""
End DoDot:1
+11 IF LA7OP(LA7OP,200,LA7OP_",",.137,"E")'=""
Begin DoDot:1
+12 SET Y=0
+13 IF X=""
SET Y=$LENGTH(LA7OP(LA7OP,200,LA7OP_",",.137,"E"))+$LENGTH(BLRTX)+16
+14 IF Y>BLRIOM!(X'="")
SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=BLRTXT
SET BLRTXT=$$FILL^BLRAGUT(10)
+15 IF '$TEST
SET X=" "_X
+16 SET BLRTXT=BLRTXT_X_"Voice Pager: "_LA7OP(LA7OP,200,LA7OP_",",.137,"E")
+17 SET X=""
End DoDot:1
+18 IF LA7OP(LA7OP,200,LA7OP_",",.138,"E")'=""
Begin DoDot:1
+19 SET Y=0
+20 IF X=""
SET Y=$LENGTH(LA7OP(LA7OP,200,LA7OP_",",.138,"E"))+$LENGTH(BLRTXT)+18
+21 IF Y>BLRIOM!(X'="")
SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=BLRTXT
SET BLRTXT=$$FILL^BLRAGUT(10)
+22 IF '$TEST
SET X=" "_X
+23 SET BLRTXT=BLRTXT_X_"Digital Pager: "_LA7OP(LA7OP,200,LA7OP_",",.138,"E")
+24 SET X=""
End DoDot:1
+25 IF BLRTXT'=""
SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=BLRTXT
+26 ;
+27 IF X=""
SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=""
+28 QUIT
+29 ;
WARN ; Write warning for work copy.
+1 SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)="*** DO NOT USE FOR SHIPPING DOCUMENT - WORK COPY ONLY ***"
+2 QUIT
+3 ;
SBC1 ; Site bar codes
+1 ;
+2 ; Print "SM" bar code
+3 ; Calculate/append LPC to barcode.
+4 IF $GET(LA7SM("BARCODE"))=""
Begin DoDot:1
+5 NEW LA7X,X,Y
+6 IF LA7SBC=1
Begin DoDot:2
+7 SET LA7X="STX^SITE^"_LA7FSITE(99)_"^"_$PIECE($GET(LA7SDT),"^")_"^"_$PIECE(LA7SM,"^",2)_"^ETX"
End DoDot:2
+8 IF LA7SBC=2
Begin DoDot:2
+9 SET LA7X="SITE^"_LA7FSITE(99)_"^"_$PIECE($GET(LA7SDT),"^")_"^"_$PIECE(LA7SM,"^",2)_"^"
End DoDot:2
+10 SET X=LA7X
XECUTE ^%ZOSF("LPC")
SET LA7SM("LPC")=Y
SET LA7SM("BARCODE")=LA7X_Y
End DoDot:1
+11 ;
+12 SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=$$FILL^BLRAGUT(17)_"SM: "_$$BC128^LA7SBC(LA7SM("BARCODE"),1,60,"","",2)
+13 SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=""
+14 ;
+15 QUIT
+16 ;
SBC2 ; Patient bar codes
+1 ;
+2 NEW LA7SDATA
+3 ;
+4 ; Print "PD" bar code
+5 IF LA7SBC=1
Begin DoDot:1
+6 SET LA7SDATA="STX^PD^"_SSN(2)_"^"_LA7FSITE(99)_"^"_LA7UID_"^"_$GET(SEX)_"^"_LA7CDT_"^ETX"_$GET(LA7SM("LPC"))
End DoDot:1
+7 ;
+8 IF LA7SBC=2
Begin DoDot:1
+9 SET LA7SDATA="PD^"_SSN(2)_"^"_LA7FSITE(99)_"^"_LA7UID_"^"_LA7CDT_"^"_$GET(LA7SM("LPC"))
End DoDot:1
+10 ;
+11 SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=""
+12 SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=$$FILL^BLRAGUT(17)_"PD: "_$$BC128^LA7SBC(LA7SDATA,1,60,"","",2)
+13 SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=""
+14 SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=$$FILL^BLRAGUT(10)_$EXTRACT(LA7LINE,1,69)
+15 ;
+16 ; Print "PD1" bar code
+17 IF LA7SBC=1
Begin DoDot:1
+18 SET LA7SDATA="STX^PD1^"_SSN(2)_"^"_PNM_"^"_DOB_"^ETX"_$GET(LA7SM("LPC"))
End DoDot:1
+19 IF LA7SBC=2
Begin DoDot:1
+20 SET LA7SDATA="PD1^"_SSN(2)_"^"_PNM_"^"_DOB_"^"_SEX_"^"_$GET(LA7SM("LPC"))
End DoDot:1
+21 ;
+22 SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=$$FILL^BLRAGUT($SELECT(BLRIOM<131:18,1:50))_"PD1: "_$$BC128^LA7SBC(LA7SDATA,1,60,"","",2)
+23 SET BLRI=BLRI+1
SET BLRY=BLRY+1
SET BLRTXT(BLRI)=""
+24 ;
+25 QUIT
