LA7CORC ;VA/DALOI/JMC - LAB ORC Segment message builder ; 22-Oct-2013 09:22 ; MAW
;;5.2;AUTOMATED LAB INSTRUMENTS;**46,1018,64,1027,68,1033**;NOV 01, 1997
;
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
;
I $G(LA7INPT),$G(LA7OBRSN)=1,LRSS="MI" Q "" ;mu2 inpatient
I $G(LA7INPT),$G(LA7OBRSN)>1,LRSS="MI" Q "" ;mu2 inpatient
I $G(LA7INPT),$G(LA7OBRSN)>1,$G(LA7ADDON) Q "" ;mu2 inpatient
I $G(LA7INPT),$G(LA7OBRSN)=1,$G(LA7ADDON) Q "" ;mu2 inpatient
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)
. I $G(LA7INPT),$G(LRSS)'="MI" S $P(LA7Y,$E(LA7ECH),3)="2.16.840.1.113883.3.72.5.24"
. I $G(LA7INPT),$G(LRSS)'="MI" S $P(LA7Y,$E(LA7ECH),4)="ISO"
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)
. I $G(LA7INPT),$G(LRSS)'="MI" S $P(LA7Y,$E(LA7ECH),3)=$P(LA7X,$E(LA7ECH),2)
. I $G(LA7INPT),$G(LRSS)'="MI" 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
;
N LA7X
S LA7IDTYP=+$G(LA7IDTYP)
S LA7X=$$XCN^LA7CHLU9(LA7DUZ,LA7DIV,LA7FS,LA7ECH,0,LA7IDTYP)
Q LA7X
;ihs/cmi/maw manipulate the data here for mu2
;
;
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
;
;
ORC14(LA7DUZ,LA7DIV,FS,ECH) ;-- call back number
N ORC14,CS,RS,PH1
S CS=$E(ECH,1)
S RS=$E(ECH,2)
S PH1=$P($G(^VA(200,LA7DUZ,.13)),U,2)
S PH2=$P($G(^VA(200,LA7DUZ,.13)),U,3)
S ORC14=CS_"WPN"_CS_"PH"_CS_CS_$E(PH1,1)_CS_$E(PH1,2,4)_CS_$E(PH1,5,11)_CS_$R(1000)_CS_"Hospital Line"
S ORC14=ORC14_RS_CS_"WPN"_CS_"PH"_CS_CS_$E(PH2,1)_CS_$E(PH2,2,4)_CS_$E(PH2,5,11)_CS_$R(1000)_CS_"Office Phone"
Q ORC14
;
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
;
N LA7X
S LA7X=$$XAD^LA7VHLU4(4,LA74,LA7DT,LA7FS,LA7ECH)
S LA7X=LA7X_$E(LA7ECH,1)_"L"_$E(LA7ECH,1)_$E(LA7ECH,1)_$P(LA7X,U,5)
Q LA7X
;
;
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,PH1,CS,RT
S CS=$E(LA7ECH,1)
S PH1=$P($G(^DIC(4,LA74,2,1,0)),U,3)
S RT=$P($G(^DIC(4,LA74,2,1,0)),U)
;
S LA7Y=CS_"WPN"_CS_"PH"_CS_CS_$E(PH1,1)_CS_$E(PH1,2,4)_CS_$E(PH1,5,11)_CS_$R(1000)_CS_RT
;
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
;
N LA7X
S LA7X=$G(^VA(200,LA7200,.11))
S LA7Y=$P(LA7X,U)_$E(LA7ECH,1)_$P(LA7X,U,2)_$E(LA7ECH,1)_$P(LA7X,U,4)_$E(LA7ECH,1)_$$GET1^DIQ(5,$P(LA7X,U,5),1)_$E(LA7ECH,1)_$P(LA7X,U,6)_$E(LA7ECH,1)_"USA"_$E(LA7ECH,1)_"B"_$E(LA7ECH,1)_$E(LA7ECH,1)_$P(LA7X,U,3)
Q LA7Y
S LA7X=$$XAD^LA7VHLU4(200,LA7200,LA7DT,LA7FS,LA7ECH)
S LA7X=LA7X_$E(LA7ECH,1)_"L"_$E(LA7ECH,1)_$E(LA7ECH,1)_$P(LA7X,U,5)
Q LA7X
;
Q LA7Y
;
ORC31 ;-- parent universal service identifier
;ihs/cmi/maw mu2
Q
;
LA7CORC ;VA/DALOI/JMC - LAB ORC Segment message builder ; 22-Oct-2013 09:22 ; MAW
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,1018,64,1027,68,1033**;NOV 01, 1997
+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 ;mu2 inpatient
IF $GET(LA7INPT)
IF $GET(LA7OBRSN)=1
IF LRSS="MI"
QUIT ""
+8 ;mu2 inpatient
IF $GET(LA7INPT)
IF $GET(LA7OBRSN)>1
IF LRSS="MI"
QUIT ""
+9 ;mu2 inpatient
IF $GET(LA7INPT)
IF $GET(LA7OBRSN)>1
IF $GET(LA7ADDON)
QUIT ""
+10 ;mu2 inpatient
IF $GET(LA7INPT)
IF $GET(LA7OBRSN)=1
IF $GET(LA7ADDON)
QUIT ""
+11 NEW LAXY,LA7Y
+12 ;
+13 SET $PIECE(LA7Y,$EXTRACT(LA7ECH),1)=$$CHKDATA^LA7VHLU3(LA7VAL,LA7FS_LA7ECH)
+14 IF $GET(LA7VAL("NMSP"))'=""
SET $PIECE(LA7Y,$EXTRACT(LA7ECH),2)=LA7VAL("NMSP")
+15 IF $GET(LA7VAL("SITE"))'=""
Begin DoDot:1
+16 ;S LA7X=$$FACDNS^LA7VHLU2(LA7VAL("SITE"),LA7FS,LA7ECH,1)
+17 ;S $P(LA7Y,$E(LA7ECH),3)=$P(LA7X,$E(LA7ECH),2)
+18 ;S $P(LA7Y,$E(LA7ECH),4)=$P(LA7X,$E(LA7ECH),3)
+19 IF $GET(LA7INPT)
IF $GET(LRSS)'="MI"
SET $PIECE(LA7Y,$EXTRACT(LA7ECH),3)="2.16.840.1.113883.3.72.5.24"
+20 IF $GET(LA7INPT)
IF $GET(LRSS)'="MI"
SET $PIECE(LA7Y,$EXTRACT(LA7ECH),4)="ISO"
End DoDot:1
+21 QUIT LA7Y
+22 ;
+23 ;
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 IF $GET(LA7INPT)
IF $GET(LRSS)'="MI"
SET $PIECE(LA7Y,$EXTRACT(LA7ECH),3)=$PIECE(LA7X,$EXTRACT(LA7ECH),2)
+14 IF $GET(LA7INPT)
IF $GET(LRSS)'="MI"
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 NEW LA7X
+11 SET LA7IDTYP=+$GET(LA7IDTYP)
+12 SET LA7X=$$XCN^LA7CHLU9(LA7DUZ,LA7DIV,LA7FS,LA7ECH,0,LA7IDTYP)
+13 QUIT LA7X
+14 ;ihs/cmi/maw manipulate the data here for mu2
+15 ;
+16 ;
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 ;
ORC14(LA7DUZ,LA7DIV,FS,ECH) ;-- call back number
+1 NEW ORC14,CS,RS,PH1
+2 SET CS=$EXTRACT(ECH,1)
+3 SET RS=$EXTRACT(ECH,2)
+4 SET PH1=$PIECE($GET(^VA(200,LA7DUZ,.13)),U,2)
+5 SET PH2=$PIECE($GET(^VA(200,LA7DUZ,.13)),U,3)
+6 SET ORC14=CS_"WPN"_CS_"PH"_CS_CS_$EXTRACT(PH1,1)_CS_$EXTRACT(PH1,2,4)_CS_$EXTRACT(PH1,5,11)_CS_$RANDOM(1000)_CS_"Hospital Line"
+7 SET ORC14=ORC14_RS_CS_"WPN"_CS_"PH"_CS_CS_$EXTRACT(PH2,1)_CS_$EXTRACT(PH2,2,4)_CS_$EXTRACT(PH2,5,11)_CS_$RANDOM(1000)_CS_"Office Phone"
+8 QUIT ORC14
+9 ;
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 NEW LA7X
+10 SET LA7X=$$XAD^LA7VHLU4(4,LA74,LA7DT,LA7FS,LA7ECH)
+11 SET LA7X=LA7X_$EXTRACT(LA7ECH,1)_"L"_$EXTRACT(LA7ECH,1)_$EXTRACT(LA7ECH,1)_$PIECE(LA7X,U,5)
+12 QUIT LA7X
+13 ;
+14 ;
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,PH1,CS,RT
+10 SET CS=$EXTRACT(LA7ECH,1)
+11 SET PH1=$PIECE($GET(^DIC(4,LA74,2,1,0)),U,3)
+12 SET RT=$PIECE($GET(^DIC(4,LA74,2,1,0)),U)
+13 ;
+14 SET LA7Y=CS_"WPN"_CS_"PH"_CS_CS_$EXTRACT(PH1,1)_CS_$EXTRACT(PH1,2,4)_CS_$EXTRACT(PH1,5,11)_CS_$RANDOM(1000)_CS_RT
+15 ;
+16 QUIT LA7Y
+17 ;
+18 ;
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 NEW LA7X
+11 SET LA7X=$GET(^VA(200,LA7200,.11))
+12 SET LA7Y=$PIECE(LA7X,U)_$EXTRACT(LA7ECH,1)_$PIECE(LA7X,U,2)_$EXTRACT(LA7ECH,1)_$PIECE(LA7X,U,4)_$EXTRACT(LA7ECH,1)_$$GET1^DIQ(5,$PIECE(LA7X,U,5),1)_$EXTRACT(LA7ECH,1)_...
... $PIECE(LA7X,U,6)_$EXTRACT(LA7ECH,1)_"USA"_$EXTRACT(LA7ECH,1)_"B"_$EXTRACT(LA7ECH,1)_$EXTRACT(LA7ECH,1)_$PIECE(LA7X,U,3)
+13 QUIT LA7Y
+14 SET LA7X=$$XAD^LA7VHLU4(200,LA7200,LA7DT,LA7FS,LA7ECH)
+15 SET LA7X=LA7X_$EXTRACT(LA7ECH,1)_"L"_$EXTRACT(LA7ECH,1)_$EXTRACT(LA7ECH,1)_$PIECE(LA7X,U,5)
+16 QUIT LA7X
+17 ;
+18 QUIT LA7Y
+19 ;
ORC31 ;-- parent universal service identifier
+1 ;ihs/cmi/maw mu2
+2 QUIT
+3 ;
