Routine: LA7CORC

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

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

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       ;

LA7CORC.m