LA7VORC ;VA/DALOI/JMC - LAB ORC Segment message builder ; 19-Nov-2014 13:22 ; MKK
;;5.2;AUTOMATED LAB INSTRUMENTS;**46,1018,64,1027,68,1033,1034**;NOV 01, 1997;Build 88
;
Q
;
ORC1(LA7TYP) ; Build ORC-1 sequence - Order control
; Call with LA7TYP = order type from table 0119
;
Q LA7TYP
;
;
ORC2(LA7VAL,LA7FS,LA7ECH) ; Build ORC-2 sequence - Placer order number
; Call with LA7VAL = accession number/UID
; LA7VAL("NMSP") = application namespace (optional)
; LA7VAL("SITE") = placer facility
; LA7FS = HL field separator
; LA7ECH = HL encoding characters
;
N LAXY,LA7Y
;
S $P(LA7Y,$E(LA7ECH),1)=$$CHKDATA^LA7VHLU3(LA7VAL,LA7FS_LA7ECH)
I $G(LA7VAL("NMSP"))'="" S $P(LA7Y,$E(LA7ECH),2)=LA7VAL("NMSP")
I $G(LA7VAL("SITE"))'="" D
. S LA7X=$$FACDNS^LA7VHLU2(LA7VAL("SITE"),LA7FS,LA7ECH,1)
. S $P(LA7Y,$E(LA7ECH),3)=$P(LA7X,$E(LA7ECH),2)
. S $P(LA7Y,$E(LA7ECH),4)=$P(LA7X,$E(LA7ECH),3)
Q LA7Y
;
;
ORC3(LA7VAL,LA7FS,LA7ECH) ; Build ORC-3 sequence - Filler order number
; Call with LA7VAL = accession number/UID
; LA7VAL("NMSP") = application namespace (optional)
; LA7VAL("SITE") = placer facility
; LA7FS = HL field separator
; LA7ECH = HL encoding characters
;
N LA7X,LA7Y
;
S $P(LA7Y,$E(LA7ECH),1)=$$CHKDATA^LA7VHLU3(LA7VAL,LA7FS_LA7ECH)
I $G(LA7VAL("NMSP"))'="" S $P(LA7Y,$E(LA7ECH),2)=LA7VAL("NMSP")
I $G(LA7VAL("SITE"))'="" D
. S LA7X=$$FACDNS^LA7VHLU2(LA7VAL("SITE"),LA7FS,LA7ECH,1)
. S $P(LA7Y,$E(LA7ECH),3)=$P(LA7X,$E(LA7ECH),2)
. S $P(LA7Y,$E(LA7ECH),4)=$P(LA7X,$E(LA7ECH),3)
;
Q LA7Y
;
;
ORC4(LA7VAL,LA7FS,LA7ECH) ; Build ORC-4 sequence - Placer group number
; Call with LA7VAL = LEDI - shipping manifest number
; LA7FS = HL field separator
; LA7ECH = HL encoding characters
; Returns ORD-4 sequence
;
N LA7Y
;
S $P(LA7Y,$E(LA7ECH),1)=$$CHKDATA^LA7VHLU3(LA7VAL,LA7FS_LA7ECH)
;
Q LA7Y
;
;
ORC5(LA7VAL,LA7FS,LA7ECH) ; Build ORC-5 sequence - Order status
; Call with LA7VAL = order status
; LA7FS = HL field separator
; LA7ECH = HL encoding characters
; Returns ORC-5 sequence
;
N LA7Y
;
I LA7VAL="CM" S LA7Y="CM"
;
Q LA7Y
;
;
ORC7(LA7DUR,LA7DURU,LA76205,LA7FS,LA7ECH) ; Build ORC-7 sequence - Quantity/Timing
; Call with LA7DUR = collection duration
; LA7DURU = duration units (pointer to #64.061)
; LA76205 = test urgency
; LA7FS = HL field separator
; LA7ECH = HL encoding characters
;
; Returns ORC-7 sequence
;
N LA7X,LA7Y
S LA7Y=""
;
I LA7DUR'="",LA7DURU D
. S LA7X=$$GET1^DIQ(64.061,LA7DURU_",",2) ; duration units
. S $P(LA7Y,$E(LA7ECH,1),3)=$$CHKDATA^LA7VHLU3(LA7X_LA7DUR,LA7FS_LA7ECH)
;
I LA76205 D
. S LA7X=$$GET1^DIQ(64.061,+$$GET1^DIQ(62.05,LA76205_",",4,"I")_",",2) ; Urgency
. S $P(LA7Y,$E(LA7ECH,1),6)=$$CHKDATA^LA7VHLU3(LA7X,LA7FS_LA7ECH)
;
Q LA7Y
;
;
ORC9(LA7DT) ; Build ORC-9 sequence - date/time of transaction
; Call with LA7DT = order date/time
;
; Returns ORC-9 sequence
;
S LA7DT=$$CHKDT^LA7VHLU1(LA7DT)
Q $$FMTHL7^XLFDT(LA7DT)
;
;
ORC12(LA7DUZ,LA7DIV,LA7FS,LA7ECH,LA7IDTYP) ; Build ORC-12 sequence - Ordering provider
; Call with LA7DUZ = DUZ of ordering provider
; LA7DIV = Facility (division) of provider
; LA7FS = HL field separator
; LA7ECH = HL encoding characters
; LA7IDTYP = id type to return (0:DUZ 1:VPID 2:NPI)
;
; Returns ORC-12 sequence
; Also used to build OBR-16 sequence
;
S LA7IDTYP=+$G(LA7IDTYP)
;Q $$XCN^LA7VHLU9(LA7DUZ,LA7DIV,LA7FS,LA7ECH,0,LA7IDTYP)
; ----- BEGIN IHS/MSC/MKK - LR*5.2*1034
;ihs/cmi/maw 3/10/2010 modified to add UPIN
N LA7PRV,LA7ORC12
S LA7PRV=$$XCN^LA7VHLU9(LA7DUZ,LA7DIV,LA7FS,LA7ECH,0,2)
S LA7ORC12=$$GET1^DIQ(200,LA7DUZ,41.99,"I")_$E(LA7ECH,1,1)_$P(LA7PRV,$E(LA7ECH,1,1),2,7)
S $P(LA7ORC12,$E(LA7ECH,1,1),8)="N" ;cmi/maw includes NPI indicator
Q $G(LA7ORC12)
;cmi/maw 3/10/2010 end of mods
; ----- END IHS/MSC/MKK - LR*5.2*1034
;
;
ORC13(LA7J,LA7FS,LA7ECH) ; Build ORC-13 sequence - Enterer's location
; Call with LA7J = variable pointer to file #4 or #44
; LA7FS = HL field separator
; LA7ECH = HL encoding characters
;
; Returns ORC-13 sequence
;
N LA74,LA744,LA7X,LA7Y,LA7Z
;
S (LA74,LA744,LA7Y)=""
;
; Pointer to file #44
I $P(LA7J,";",2)="SC(" D
. S LA744=$P(LA7J,";")
. S LA74=$$GET1^DIQ(44,LA744_",",3,"I")
;
; Pointer to file #4
I $P(LA7J,";",2)="DIC(4," S LA74=$P(LA7J,";")
;
; Build 1st component (point of care), 6th component (person location type)
I LA744 D
. S LA7Z=$$GET1^DIQ(44,LA744_",",.01)
. S $P(LA7Y,$E(LA7ECH,1),1)=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
. S LA7Z=$$GET1^DIQ(44,LA744_",",2,"I")
. S $P(LA7Y,$E(LA7ECH,1),6)=$S(LA7Z="C":"C",LA7Z="W":"N",1:"D")
;
; Build 4th component (facility), demote delimiter from component to sub-component
I LA74 D
. S LA7Z=$$FACDNS^LA7VHLU2(LA74,LA7FS,LA7ECH,2)
. I $P(LA7Z,$E(LA7ECH,4),2)'="" S $P(LA7Y,$E(LA7ECH,1),4)=LA7Z Q
. S LA7Z=$$INST^LA7VHLU4(LA74,LA7FS,LA7ECH)
. I $P(LA7Z,$E(LA7ECH,1),3)="99VA4" S $P(LA7Z,$E(LA7ECH,1),3)="L"
. S $P(LA7Y,$E(LA7ECH,1),4)=$TR(LA7Z,$E(LA7ECH,1),$E(LA7ECH,4))
;
Q LA7Y
;
;
ORC17(LA74,LA7FS,LA7ECH) ; Build ORC-17 sequence - Entering organization
; Call with LA74 = ien of institution in file #4
; if null/undefined then use Kernel Site file.
; LA7FS = HL field separator
; LA7ECH = HL encoding characters
;
; Returns ORC-17 sequence (ID^text^99VA4)
;
Q $$INST^LA7VHLU4(LA74,LA7FS,LA7ECH)
;
;
ORC21(LA74,LA7FS,LA7ECH) ; Build ORC-21 sequence - Ordering facility name
; Call with LA74 = ien of institution in file #4
; LA7FS = HL field separator
; LA7ECH = HL encoding characters
;
; Returns ORC-21 sequence
;
Q $$XON^LA7VHLU4(4,LA74,0,LA7FS,LA7ECH)
;
;
ORC22(LA74,LA7DT,LA7FS,LA7ECH) ; Build ORC-22 sequence - Ordering facility address
; Call with LA74 = ien of institution in file #4
; if null/undefined then use Kernel Site file.
; LA7DT = "as of" date in FileMan format
; LA7FS = HL field separator
; LA7ECH = HL encoding characters
;
; Returns ORC-22 sequence
;
Q $$XAD^LA7VHLU4(4,LA74,LA7DT,LA7FS,LA7ECH)
;
;
ORC23(LA74,LA7DT,LA7FS,LA7ECH) ; Build ORC-23 sequence - Ordering facility phone number
; Call with LA74 = ien of institution in file #4
; if null/undefined then use Kernel Site file.
; LA7DT = "as of" date in FileMan format
; LA7FS = HL field separator
; LA7ECH = HL encoding characters
;
; Returns ORC-23 sequence
;
N LA7Y
;
S LA7Y=""
;
Q LA7Y
;
;
ORC24(LA7200,LA7DT,LA7FS,LA7ECH) ; Build ORC-24 sequence - Ordering provider address
; Call with LA7200 = ien of provider in file #200
; LA7DT = "as of" date in FileMan format
; LA7FS = HL field separator
; LA7ECH = HL encoding characters
;
; Returns ORC-24 sequence
;
N LA7Y
;
S LA7Y=""
;
Q LA7Y
LA7VORC ;VA/DALOI/JMC - LAB ORC Segment message builder ; 19-Nov-2014 13:22 ; MKK
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,1018,64,1027,68,1033,1034**;NOV 01, 1997;Build 88
+2 ;
+3 QUIT
+4 ;
ORC1(LA7TYP) ; Build ORC-1 sequence - Order control
+1 ; Call with LA7TYP = order type from table 0119
+2 ;
+3 QUIT LA7TYP
+4 ;
+5 ;
ORC2(LA7VAL,LA7FS,LA7ECH) ; Build ORC-2 sequence - Placer order number
+1 ; Call with LA7VAL = accession number/UID
+2 ; LA7VAL("NMSP") = application namespace (optional)
+3 ; LA7VAL("SITE") = placer facility
+4 ; LA7FS = HL field separator
+5 ; LA7ECH = HL encoding characters
+6 ;
+7 NEW LAXY,LA7Y
+8 ;
+9 SET $PIECE(LA7Y,$EXTRACT(LA7ECH),1)=$$CHKDATA^LA7VHLU3(LA7VAL,LA7FS_LA7ECH)
+10 IF $GET(LA7VAL("NMSP"))'=""
SET $PIECE(LA7Y,$EXTRACT(LA7ECH),2)=LA7VAL("NMSP")
+11 IF $GET(LA7VAL("SITE"))'=""
Begin DoDot:1
+12 SET LA7X=$$FACDNS^LA7VHLU2(LA7VAL("SITE"),LA7FS,LA7ECH,1)
+13 SET $PIECE(LA7Y,$EXTRACT(LA7ECH),3)=$PIECE(LA7X,$EXTRACT(LA7ECH),2)
+14 SET $PIECE(LA7Y,$EXTRACT(LA7ECH),4)=$PIECE(LA7X,$EXTRACT(LA7ECH),3)
End DoDot:1
+15 QUIT LA7Y
+16 ;
+17 ;
ORC3(LA7VAL,LA7FS,LA7ECH) ; Build ORC-3 sequence - Filler order number
+1 ; Call with LA7VAL = accession number/UID
+2 ; LA7VAL("NMSP") = application namespace (optional)
+3 ; LA7VAL("SITE") = placer facility
+4 ; LA7FS = HL field separator
+5 ; LA7ECH = HL encoding characters
+6 ;
+7 NEW LA7X,LA7Y
+8 ;
+9 SET $PIECE(LA7Y,$EXTRACT(LA7ECH),1)=$$CHKDATA^LA7VHLU3(LA7VAL,LA7FS_LA7ECH)
+10 IF $GET(LA7VAL("NMSP"))'=""
SET $PIECE(LA7Y,$EXTRACT(LA7ECH),2)=LA7VAL("NMSP")
+11 IF $GET(LA7VAL("SITE"))'=""
Begin DoDot:1
+12 SET LA7X=$$FACDNS^LA7VHLU2(LA7VAL("SITE"),LA7FS,LA7ECH,1)
+13 SET $PIECE(LA7Y,$EXTRACT(LA7ECH),3)=$PIECE(LA7X,$EXTRACT(LA7ECH),2)
+14 SET $PIECE(LA7Y,$EXTRACT(LA7ECH),4)=$PIECE(LA7X,$EXTRACT(LA7ECH),3)
End DoDot:1
+15 ;
+16 QUIT LA7Y
+17 ;
+18 ;
ORC4(LA7VAL,LA7FS,LA7ECH) ; Build ORC-4 sequence - Placer group number
+1 ; Call with LA7VAL = LEDI - shipping manifest number
+2 ; LA7FS = HL field separator
+3 ; LA7ECH = HL encoding characters
+4 ; Returns ORD-4 sequence
+5 ;
+6 NEW LA7Y
+7 ;
+8 SET $PIECE(LA7Y,$EXTRACT(LA7ECH),1)=$$CHKDATA^LA7VHLU3(LA7VAL,LA7FS_LA7ECH)
+9 ;
+10 QUIT LA7Y
+11 ;
+12 ;
ORC5(LA7VAL,LA7FS,LA7ECH) ; Build ORC-5 sequence - Order status
+1 ; Call with LA7VAL = order status
+2 ; LA7FS = HL field separator
+3 ; LA7ECH = HL encoding characters
+4 ; Returns ORC-5 sequence
+5 ;
+6 NEW LA7Y
+7 ;
+8 IF LA7VAL="CM"
SET LA7Y="CM"
+9 ;
+10 QUIT LA7Y
+11 ;
+12 ;
ORC7(LA7DUR,LA7DURU,LA76205,LA7FS,LA7ECH) ; Build ORC-7 sequence - Quantity/Timing
+1 ; Call with LA7DUR = collection duration
+2 ; LA7DURU = duration units (pointer to #64.061)
+3 ; LA76205 = test urgency
+4 ; LA7FS = HL field separator
+5 ; LA7ECH = HL encoding characters
+6 ;
+7 ; Returns ORC-7 sequence
+8 ;
+9 NEW LA7X,LA7Y
+10 SET LA7Y=""
+11 ;
+12 IF LA7DUR'=""
IF LA7DURU
Begin DoDot:1
+13 ; duration units
SET LA7X=$$GET1^DIQ(64.061,LA7DURU_",",2)
+14 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),3)=$$CHKDATA^LA7VHLU3(LA7X_LA7DUR,LA7FS_LA7ECH)
End DoDot:1
+15 ;
+16 IF LA76205
Begin DoDot:1
+17 ; Urgency
SET LA7X=$$GET1^DIQ(64.061,+$$GET1^DIQ(62.05,LA76205_",",4,"I")_",",2)
+18 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),6)=$$CHKDATA^LA7VHLU3(LA7X,LA7FS_LA7ECH)
End DoDot:1
+19 ;
+20 QUIT LA7Y
+21 ;
+22 ;
ORC9(LA7DT) ; Build ORC-9 sequence - date/time of transaction
+1 ; Call with LA7DT = order date/time
+2 ;
+3 ; Returns ORC-9 sequence
+4 ;
+5 SET LA7DT=$$CHKDT^LA7VHLU1(LA7DT)
+6 QUIT $$FMTHL7^XLFDT(LA7DT)
+7 ;
+8 ;
ORC12(LA7DUZ,LA7DIV,LA7FS,LA7ECH,LA7IDTYP) ; Build ORC-12 sequence - Ordering provider
+1 ; Call with LA7DUZ = DUZ of ordering provider
+2 ; LA7DIV = Facility (division) of provider
+3 ; LA7FS = HL field separator
+4 ; LA7ECH = HL encoding characters
+5 ; LA7IDTYP = id type to return (0:DUZ 1:VPID 2:NPI)
+6 ;
+7 ; Returns ORC-12 sequence
+8 ; Also used to build OBR-16 sequence
+9 ;
+10 SET LA7IDTYP=+$GET(LA7IDTYP)
+11 ;Q $$XCN^LA7VHLU9(LA7DUZ,LA7DIV,LA7FS,LA7ECH,0,LA7IDTYP)
+12 ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1034
+13 ;ihs/cmi/maw 3/10/2010 modified to add UPIN
+14 NEW LA7PRV,LA7ORC12
+15 SET LA7PRV=$$XCN^LA7VHLU9(LA7DUZ,LA7DIV,LA7FS,LA7ECH,0,2)
+16 SET LA7ORC12=$$GET1^DIQ(200,LA7DUZ,41.99,"I")_$EXTRACT(LA7ECH,1,1)_$PIECE(LA7PRV,$EXTRACT(LA7ECH,1,1),2,7)
+17 ;cmi/maw includes NPI indicator
SET $PIECE(LA7ORC12,$EXTRACT(LA7ECH,1,1),8)="N"
+18 QUIT $GET(LA7ORC12)
+19 ;cmi/maw 3/10/2010 end of mods
+20 ; ----- END IHS/MSC/MKK - LR*5.2*1034
+21 ;
+22 ;
ORC13(LA7J,LA7FS,LA7ECH) ; Build ORC-13 sequence - Enterer's location
+1 ; Call with LA7J = variable pointer to file #4 or #44
+2 ; LA7FS = HL field separator
+3 ; LA7ECH = HL encoding characters
+4 ;
+5 ; Returns ORC-13 sequence
+6 ;
+7 NEW LA74,LA744,LA7X,LA7Y,LA7Z
+8 ;
+9 SET (LA74,LA744,LA7Y)=""
+10 ;
+11 ; Pointer to file #44
+12 IF $PIECE(LA7J,";",2)="SC("
Begin DoDot:1
+13 SET LA744=$PIECE(LA7J,";")
+14 SET LA74=$$GET1^DIQ(44,LA744_",",3,"I")
End DoDot:1
+15 ;
+16 ; Pointer to file #4
+17 IF $PIECE(LA7J,";",2)="DIC(4,"
SET LA74=$PIECE(LA7J,";")
+18 ;
+19 ; Build 1st component (point of care), 6th component (person location type)
+20 IF LA744
Begin DoDot:1
+21 SET LA7Z=$$GET1^DIQ(44,LA744_",",.01)
+22 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),1)=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
+23 SET LA7Z=$$GET1^DIQ(44,LA744_",",2,"I")
+24 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),6)=$SELECT(LA7Z="C":"C",LA7Z="W":"N",1:"D")
End DoDot:1
+25 ;
+26 ; Build 4th component (facility), demote delimiter from component to sub-component
+27 IF LA74
Begin DoDot:1
+28 SET LA7Z=$$FACDNS^LA7VHLU2(LA74,LA7FS,LA7ECH,2)
+29 IF $PIECE(LA7Z,$EXTRACT(LA7ECH,4),2)'=""
SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),4)=LA7Z
QUIT
+30 SET LA7Z=$$INST^LA7VHLU4(LA74,LA7FS,LA7ECH)
+31 IF $PIECE(LA7Z,$EXTRACT(LA7ECH,1),3)="99VA4"
SET $PIECE(LA7Z,$EXTRACT(LA7ECH,1),3)="L"
+32 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),4)=$TRANSLATE(LA7Z,$EXTRACT(LA7ECH,1),$EXTRACT(LA7ECH,4))
End DoDot:1
+33 ;
+34 QUIT LA7Y
+35 ;
+36 ;
ORC17(LA74,LA7FS,LA7ECH) ; Build ORC-17 sequence - Entering organization
+1 ; Call with LA74 = ien of institution in file #4
+2 ; if null/undefined then use Kernel Site file.
+3 ; LA7FS = HL field separator
+4 ; LA7ECH = HL encoding characters
+5 ;
+6 ; Returns ORC-17 sequence (ID^text^99VA4)
+7 ;
+8 QUIT $$INST^LA7VHLU4(LA74,LA7FS,LA7ECH)
+9 ;
+10 ;
ORC21(LA74,LA7FS,LA7ECH) ; Build ORC-21 sequence - Ordering facility name
+1 ; Call with LA74 = ien of institution in file #4
+2 ; LA7FS = HL field separator
+3 ; LA7ECH = HL encoding characters
+4 ;
+5 ; Returns ORC-21 sequence
+6 ;
+7 QUIT $$XON^LA7VHLU4(4,LA74,0,LA7FS,LA7ECH)
+8 ;
+9 ;
ORC22(LA74,LA7DT,LA7FS,LA7ECH) ; Build ORC-22 sequence - Ordering facility address
+1 ; Call with LA74 = ien of institution in file #4
+2 ; if null/undefined then use Kernel Site file.
+3 ; LA7DT = "as of" date in FileMan format
+4 ; LA7FS = HL field separator
+5 ; LA7ECH = HL encoding characters
+6 ;
+7 ; Returns ORC-22 sequence
+8 ;
+9 QUIT $$XAD^LA7VHLU4(4,LA74,LA7DT,LA7FS,LA7ECH)
+10 ;
+11 ;
ORC23(LA74,LA7DT,LA7FS,LA7ECH) ; Build ORC-23 sequence - Ordering facility phone number
+1 ; Call with LA74 = ien of institution in file #4
+2 ; if null/undefined then use Kernel Site file.
+3 ; LA7DT = "as of" date in FileMan format
+4 ; LA7FS = HL field separator
+5 ; LA7ECH = HL encoding characters
+6 ;
+7 ; Returns ORC-23 sequence
+8 ;
+9 NEW LA7Y
+10 ;
+11 SET LA7Y=""
+12 ;
+13 QUIT LA7Y
+14 ;
+15 ;
ORC24(LA7200,LA7DT,LA7FS,LA7ECH) ; Build ORC-24 sequence - Ordering provider address
+1 ; Call with LA7200 = ien of provider in file #200
+2 ; LA7DT = "as of" date in FileMan format
+3 ; LA7FS = HL field separator
+4 ; LA7ECH = HL encoding characters
+5 ;
+6 ; Returns ORC-24 sequence
+7 ;
+8 NEW LA7Y
+9 ;
+10 SET LA7Y=""
+11 ;
+12 QUIT LA7Y
