| [613] | 1 | LA7VOBX2 ;DALOI/JMC - LAB OBX Segment message builder (AP subscripts) cont'd ; 05/26/00
|
|---|
| 2 | ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64**;Sep 27, 1994
|
|---|
| 3 | ;
|
|---|
| 4 | AP ; Build OBX segments for resultss that are anatomic/surgical pathology subscripts
|
|---|
| 5 | ; Called by LA7VOBX
|
|---|
| 6 | ;
|
|---|
| 7 | N LA7953,LA7ACODE,LA7CODE,LA7DIV,LA7IENS,LA7OBX5,LA7OBX5M,LA7SUB,LA7SUBFL,LA7VP,LA7WP,LA7X,LA7Y
|
|---|
| 8 | ;
|
|---|
| 9 | S (LA7953,LA7DIV,LA7VP)=""
|
|---|
| 10 | ;
|
|---|
| 11 | ; Surgical pathology subscript
|
|---|
| 12 | I LRSS="SP" S LA7SUBFL=63.08
|
|---|
| 13 | ;
|
|---|
| 14 | ; Cytology subscript
|
|---|
| 15 | I LRSS="CY" S LA7SUBFL=63.09
|
|---|
| 16 | ;
|
|---|
| 17 | ; Electron microscopy subscript
|
|---|
| 18 | I LRSS="EM" S LA7SUBFL=63.02
|
|---|
| 19 | ;
|
|---|
| 20 | S LA7IENS=""
|
|---|
| 21 | F I=3:-1:1 I $P(LRIDT,",",I) S LRIDT(I)=$P(LRIDT,",",I),LA7IENS=LA7IENS_LRIDT(I)_","
|
|---|
| 22 | S LA7IENS=LA7IENS_LRDFN_","
|
|---|
| 23 | S LRIDT=$P(LRIDT,",")
|
|---|
| 24 | S LA7SUB(0)=$G(^LR(LRDFN,LRSS,LRIDT,0))
|
|---|
| 25 | ;
|
|---|
| 26 | ; Get default codes
|
|---|
| 27 | S LA7CODE=$$DEFCODE^LA7VHLU5(LRSS,LRSB,"","")
|
|---|
| 28 | ;
|
|---|
| 29 | ; Initialize OBX segment
|
|---|
| 30 | S LA7OBX(0)="OBX"
|
|---|
| 31 | ;
|
|---|
| 32 | ; Value type
|
|---|
| 33 | S LA7X=LA7SUBFL,LA7Y=LRSB
|
|---|
| 34 | I LRSS="SP" D
|
|---|
| 35 | . I LRSB=1.2 S LA7X=63.817,LA7Y=1
|
|---|
| 36 | . I LRSB="10,1.5" S LA7X=63.82,LA7Y=.01
|
|---|
| 37 | . I LRSB="10,2" S LA7X=63.12,LA7Y=2
|
|---|
| 38 | . I LRSB="10,5" S LA7X=63.819,LA7Y=1
|
|---|
| 39 | S LA7OBX(2)=$$OBX2^LA7VOBX(LA7X,LA7Y)
|
|---|
| 40 | ;
|
|---|
| 41 | ; Observation identifier
|
|---|
| 42 | S LA7OBX(3)=$$OBX3^LA7VOBX($P(LA7CODE,"!",2),$P(LA7CODE,"!",3),"",LA7FS,LA7ECH)
|
|---|
| 43 | ;
|
|---|
| 44 | ; Observation sub-ID
|
|---|
| 45 | ; Create sub-ID for supplementary reports and special studies
|
|---|
| 46 | I LRSS="SP" D SUBID
|
|---|
| 47 | ;
|
|---|
| 48 | ; Build result field
|
|---|
| 49 | I LRSB=.012 D
|
|---|
| 50 | . N LA7I,LA7X,LA7Y
|
|---|
| 51 | . S LA7I=0
|
|---|
| 52 | . F S LA7I=$O(^LR(LRDFN,LRSS,LRIDT,.1,LA7I)) Q:'LA7I D
|
|---|
| 53 | . . S LA7X=$G(^LR(LRDFN,LRSS,LRIDT,.1,LA7I,0))
|
|---|
| 54 | . . S LA7Y(LA7I)=$P(LA7X,"^")
|
|---|
| 55 | . S LA7OBX(5)=$$OBX5R^LA7VOBX(.LA7Y,LA7OBX(2),LA7FS,LA7ECH)
|
|---|
| 56 | ;
|
|---|
| 57 | I LRSB'=.012 D
|
|---|
| 58 | . I LRSS="SP",$P(LRSB,",")=10,LRSB'="10,5" Q
|
|---|
| 59 | . I LA7NVAF=1 D DOD Q
|
|---|
| 60 | . I LRSS="SP",LRSB=1.2 N LRSB S LA7SUBFL=63.817,LRSB=1
|
|---|
| 61 | . I LRSS="SP",LRSB="10,5" N LRSB S LA7SUBFL=63.819,LRSB=1
|
|---|
| 62 | . D OBX5M^LA7VOBX(LA7SUBFL,LA7IENS,LRSB,.LA7WP,LA7FS,LA7ECH)
|
|---|
| 63 | . D BUILDSEG^LA7VHLU(.LA7WP,.LA7OBX5M,"")
|
|---|
| 64 | . M LA7OBX(5)=LA7OBX5M
|
|---|
| 65 | ;
|
|---|
| 66 | I LRSS="SP",$P(LRSB,",")=10 D
|
|---|
| 67 | . N LA7VAL,X
|
|---|
| 68 | . I LRSB=10 D
|
|---|
| 69 | . . S LA7VAL=$$GET1^DIQ(63.12,LA7IENS,.01)
|
|---|
| 70 | . . S X=$$GET1^DIQ(63.12,LA7IENS,".01:2")
|
|---|
| 71 | . . I $L(X) S LA7VAL=$S($E(X,1,2)="T-":"",1:"T-")_X_"^"_LA7VAL_"^SNM"
|
|---|
| 72 | . . S LA7OBX(5)=$$OBX5^LA7VOBX(LA7VAL,LA7OBX(2),LA7FS,LA7ECH)
|
|---|
| 73 | . I LRSB="10,2" D
|
|---|
| 74 | . . S LA7VAL=$$GET1^DIQ(63.12,LA7IENS,2)
|
|---|
| 75 | . . S LA7OBX(5)=$$OBX5^LA7VOBX(LA7VAL,LA7OBX(2),LA7FS,LA7ECH)
|
|---|
| 76 | . . S LA7OBX(6)=$$OBX6^LA7VOBX("g","",LA7FS,LA7ECH)
|
|---|
| 77 | ;
|
|---|
| 78 | ; Don't build this segment if no results/value to send
|
|---|
| 79 | I $G(LA7OBX(5,0))="",$G(LA7OBX(5))="" Q
|
|---|
| 80 | ;
|
|---|
| 81 | ; Build sequence id
|
|---|
| 82 | S LA7OBX(1)=$$OBX1^LA7VOBX(.LA7OBXSN)
|
|---|
| 83 | ;
|
|---|
| 84 | ; "P"artial, "F"inal , "A"mended results
|
|---|
| 85 | ; If not release date then pending
|
|---|
| 86 | I '$P(LA7SUB(0),"^",11) S LA7OBX(11)="P"
|
|---|
| 87 | ;
|
|---|
| 88 | ; If release date then check for changes
|
|---|
| 89 | I $P(LA7SUB(0),"^",11) D
|
|---|
| 90 | . I $P(LA7SUB(0),"^",15) S LA7OBX(11)="C"
|
|---|
| 91 | . E S LA7OBX(11)="F"
|
|---|
| 92 | ;
|
|---|
| 93 | I $P(LA7SUB(0),"^",13),$$DIV4^XUSER(.LA7DIV,$P(LA7SUB(0),"^",2)) S LA7DIV=$O(LA7DIV(0))
|
|---|
| 94 | ;
|
|---|
| 95 | ; Facility that performed the testing
|
|---|
| 96 | S LA7OBX(15)=$$OBX15^LA7VOBX(LA7DIV,LA7FS,LA7ECH)
|
|---|
| 97 | ;
|
|---|
| 98 | ; Person that verified the test
|
|---|
| 99 | S LA7VP=$P(LA7SUB(0),"^",13)
|
|---|
| 100 | I LA7VP S LA7OBX(16)=$$OBX16^LA7VOBX(LA7VP,LA7DIV,LA7FS,LA7ECH)
|
|---|
| 101 | ;
|
|---|
| 102 | D BUILDSEG^LA7VHLU(.LA7OBX,.LA7ARRAY,LA7FS)
|
|---|
| 103 | ;
|
|---|
| 104 | Q
|
|---|
| 105 | ;
|
|---|
| 106 | ;
|
|---|
| 107 | SUBID ; Build sub-id for "SP" subscript
|
|---|
| 108 | ; Used to identify supplementary reports, specimens and related special
|
|---|
| 109 | ; studies performed on thoese specimens.
|
|---|
| 110 | ;
|
|---|
| 111 | N LA7SUBID
|
|---|
| 112 | ;
|
|---|
| 113 | S LA7SUBID=""
|
|---|
| 114 | ;
|
|---|
| 115 | ; Sub-id's for supplementary reports
|
|---|
| 116 | I LRSB=1.2 S LA7SUBID="1."_$P(LA7IENS,",")
|
|---|
| 117 | ;
|
|---|
| 118 | ; Sub-id's for specimens and special studies
|
|---|
| 119 | I LRSB=10!(LRSB="10,2") S LA7SUBID="10."_$P(LA7IENS,",")
|
|---|
| 120 | I LRSB="10,1.5"!(LRSB="10,5") S LA7SUBID="10."_$P(LA7IENS,",",2)_"."_$P(LA7IENS,",")
|
|---|
| 121 | ;
|
|---|
| 122 | I $L(LA7SUBID) S LA7OBX(4)=$$OBX4^LA7VOBX(LA7SUBID,LA7FS,LA7ECH)
|
|---|
| 123 | ;
|
|---|
| 124 | Q
|
|---|
| 125 | ;
|
|---|
| 126 | ;
|
|---|
| 127 | DOD ; Build OBX segment's to special DoD specifications.
|
|---|
| 128 | ; Send word-processing fields as series of OBX's for DoD.
|
|---|
| 129 | ; DoD cannot handle formatted text (FT) data type.
|
|---|
| 130 | ;
|
|---|
| 131 | S LA7OBX(2)="ST"
|
|---|
| 132 | S LA7VAL=$G(^LR(LRDFN,LRSS,$P(LA7IDT,","),LA7SB,$P(LA7IDT,",",2),0))
|
|---|
| 133 | I LA7VAL="" S LA7VAL=" "
|
|---|
| 134 | S LA7OBX(5)=$$OBX5^LA7VOBX(LA7VAL,LA7OBX(2),LA7FS,LA7ECH)
|
|---|
| 135 | Q
|
|---|
