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

BLRAG09E.m

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