- LA7VIN5B ;DALOI/JMC - Process Incoming UI Msgs, continued ;11/17/11 16:09
- ;;5.2;AUTOMATED LAB INSTRUMENTS;**74**;Sep 27, 1994;Build 229
- ;
- ; This routine is a continuation of LA7VIN5.
- ;
- Q
- ;
- ;
- ORESULTS ; Process results that accompany order (ORM) messages
- ;
- N I,LA74,LA764,LA7DIE,LA7ERR,LA7I,LA7WP,LA7X,LA7Y,X,Y
- ;
- ; Identify producing laboratory
- S LA7X=$$P^LA7VHLU(.LA7SEG,24,LA7FS),LA74=""
- I $P(LA7X,LA7CS,6)="CLIA" S LA74=$$IDX^XUAF4("CLIA",$P(LA7X,LA7CS,10))
- I 'LA74 S LA74=$$RESFID^LA7VHLU2($$P^LA7VHLU(.LA7SEG,16,LA7FS),LA7SFAC,LA7CS)
- ;
- ; Special handling of AP specimen codes in OBX segment.
- I LA7TEST(0,1)="LN",LA7TEST="22633-2" D APSPEC Q
- ;
- ; Special handling of AP specimen codes in OBX segment used by DoD CHCS
- I LA7TEST(0,1)="AS4",LA7TEST="5000.12" D APSPEC Q
- I LA7TEST(0,1)="99LAB",LA7TEST="TOP" D APSPEC Q
- ;
- ; Special handling of AP data in OBX segments
- I LA7TEST(0,1)="LN","10215-2^10218-6^10219-4^22634-0^22635-7^22636-5^22637-3^22639-9^"[LA7TEST D APDATA Q
- ;
- ; Special handling of frozen section AP data used by VistA.
- I LA7TEST(0,1)="99VA64",LA7TEST="88569.0000" D APDATA Q
- ;
- ; Special handling of AP data in OBX segments used by DoD CHCS.
- I LA7TEST(0,1)="AS4","5000.3^5000.4^5000.10^"[LA7TEST D APDATA Q
- ;
- S LA7I=2,X=""
- ;
- I LA7RLNC D
- . S X="[LOINC "_$$GET1^DIQ(95.3,LA7RLNC_",",.01)_"] "
- . S Y=$$GET1^DIQ(95.3,LA7RLNC_",",81)
- . I Y="" S Y=$$GET1^DIQ(95.3,LA7RLNC_",",80)
- . S X=X_Y
- I 'LA7RLNC,LA7RNLT D
- . S LA764=$$FIND1^DIC(64,"","X",LA7RNLT,"E","","LA7ERR")
- . I 'LA764 S LA7RNLT="" Q
- . S X="[NLT "_$$GET1^DIQ(64,LA764_",",1)_"] "_$$GET1^DIQ(64,LA764_",",.01,"I")
- I 'LA7RLNC,'LA7RNLT D
- . I LA7TEST(0)]""!(LA7TEST]"") S X="["_LA7TEST(0,1)_" "_LA7TEST_"] "_LA7TEST(0) Q
- . S X="["_LA7TEST(2,1)_" "_LA7TEST(2)_"] "_LA7TEST(2,0)
- ;
- S LA7WP(LA7I,0)="Test result: "_X
- ;
- ; Date value
- I LA7VTYP?1(1"DT",1"TS") D
- . S LA7X=$$P^LA7VHLU(.LA7SEG,6,LA7FS)
- . S LA7X=$$HL7TFM^XLFDT(LA7X,"L")
- . S LA7I=LA7I+1,LA7WP(LA7I,0)=" Test value: "_LA7X
- ;
- ; Coded entry
- I LA7VTYP?1(1"CE",1"CM",1"CNE",1"CWE") D
- . S LA7X=$P($$P^LA7VHLU(.LA7SEG,6,LA7FS),LA7CS,2)
- . S LA7X=$$UNESC^LA7VHLU3(LA7X,LA7FS_LA7ECH)
- . S LA7I=LA7I+1,LA7WP(LA7I,0)=" Test value: "_LA7X_$S(LA7UNITS'="":" "_LA7UNITS,1:"")
- ;
- ; Numeric/ Structured Numeric value
- I LA7VTYP?1(1"NM",1"SN") D
- . S LA7X=$$P^LA7VHLU(.LA7SEG,6,LA7FS)
- . S LA7X=$$UNESC^LA7VHLU3(LA7X,LA7FS_LA7ECH)
- . S LA7I=LA7I+1,LA7WP(LA7I,0)=" Test value: "_LA7X_$S(LA7UNITS]"":" "_LA7UNITS,1:"")
- ;
- ; String Data/ Formatted Text/ Text Data
- I LA7VTYP?1(1"ST",1"FT",1"TX") D
- . D PA^LA7VHLU(.LA7SEG,6,LA7FS,.LA7X)
- . D UNESCFT^LA7VHLU3(.LA7X,LA7FS_LA7ECH,.LA7Y)
- . I LA7Y=1,(($L(LA7Y(1,0))+$L(LA7UNITS))<225) S LA7I=LA7I+1,LA7WP(LA7I,0)=" Test value: "_LA7Y(1,0)_$S(LA7UNITS]"":" "_LA7UNITS,1:"") Q
- . S LA7I=LA7I+1,LA7WP(LA7I,0)=" Test value:"
- . F I=1:1:LA7Y S LA7I=LA7I+1,LA7WP(LA7I,0)=LA7Y(I,0)
- . I LA7UNITS'="" S LA7I=LA7I+1,LA7WP(LA7I,0)=" Test units: "_LA7UNITS
- ;
- ; Normals/ Reference range
- S LA7X=$$P^LA7VHLU(.LA7SEG,8,LA7FS)
- I LA7X'="" S LA7I=LA7I+1,LA7WP(LA7I,0)=" Test normals: "_LA7X
- ;
- ; Normalcy status
- S LA7X=$$P^LA7VHLU(.LA7SEG,9,LA7FS)
- I LA7X'="" D
- . S X=" L^ H^LL^HH^ <^ >^ N^ A^AA^ U^ D^ B^ W^ S^ R^ I^MS^VS"
- . S I=$F(X,LA7X)\3,LA7X=$P($T(ABFLAGS+I^LA7VHLU1),";;",2)
- . I LA7X'="" S LA7I=LA7I+1,LA7WP(LA7I,0)=" Test normalcy status: "_LA7X
- ;
- I $D(LA7WP) S LA7WP(1,0)=" " D WP^DIE(69.6,LA7696_",",99,"A","LA7WP","LA7DIE(99)")
- Q
- ;
- ;
- APSPEC ; Process anatomic pathology specimens that accompany order (ORM) messages
- ;
- N I,FDA,LA761,LA762,LA76961,LA7ALTXT,LA7DIE,LA7IEN,LA7TXT,LA7VAL,LA7X,LA7Y
- ;
- S (LA761,LA7ALTXT,LA7TXT)=""
- S LA7VAL=$$P^LA7VHLU(.LA7SEG,6,LA7FS)
- ;
- ; Coded entry
- I LA7VTYP?1(1"CE",1"CM",1"CNE",1"CWE") D
- . D FLD2ARR^LA7VHLU7(.LA7VAL,LA7FS_LA7ECH)
- . F I=1,4 D
- . . I $G(LA7VAL(I+2))="SCT" D Q
- . . . N LA7HL7
- . . . S LA7HL7("FSEC")=LA7FS_LA7ECH
- . . . S LA7HL7("OBX",3)=$$P^LA7VHLU(.LA7SEG,4,LA7FS)
- . . . S LA7HL7("OBX",5)=$$P^LA7VHLU(.LA7SEG,6,LA7FS)
- . . . S LA761=$$SCT2IEN^LA7VHLU6(LA7VAL(I),LA7VAL(I+1),$G(LA7VAL($S(I=1:7,1:8))),61,0,LA76248)
- . . . I 'LA761 S LA761=+$$EN^LRSCTX(61,LA7VAL(I+1),LA7VAL(I),.LA7HL7)
- . . . S LA7ALTXT=LA7VAL(I+1)
- . . I $G(LA7VAL(I+2))="",$G(LA7VAL(I+1))'="" S LA7TXT=LA7VAL(I+1)
- ;
- I LA7VTYP?1(1"ST",1"FT",1"TX") S LA7TXT=$$UNESC^LA7VHLU3(LA7VAL,LA7FS_LA7ECH)
- ;
- ; Handle OBX-3 with LOINC code
- I LA7TEST(0,1)="LN",LA7TEST="22633-2" D
- . I LA7TXT="",LA7ALTXT="" Q
- . S FDA(1,69.6061,"+2,"_LA7696_",",.01)=$S(LA7TXT'="":LA7TXT,1:LA7ALTXT)
- . I LA761 S FDA(1,69.6061,"+2,"_LA7696_",",.02)=LA761
- ;
- ; Handle OBX-3 with old AS4 code from HL7 standard - used by DoD CHCS
- I LA7TEST(0,1)="AS4",LA7TEST="5000.12",LA7TXT'="" S FDA(1,69.6061,"+2,"_LA7696_",",.01)=LA7TXT
- ;
- ; Handle OBX-3 with 99LAB - used by DoD CHCS
- I LA7TEST(0,1)="99LAB",LA7TEST="TOP" D
- . N LA7HL7
- . S LA7HL7("FSEC")=LA7FS_LA7ECH
- . S LA7HL7("OBX",3)=$$P^LA7VHLU(.LA7SEG,4,LA7FS)
- . S LA7HL7("OBX",5)=$$P^LA7VHLU(.LA7SEG,6,LA7FS)
- . I LA7VTYP?1(1"ST",1"FT",1"TX"),LA7TXT'="" S FDA(1,69.6061,"+2,"_LA7696_",",.01)=LA7TXT Q
- . S LA761=+$$EN^LRSCTX(61,LA7VAL,"",.LA7HL7)
- . S LA7IEN=$O(^LRO(69.6,LA7696,61," "),-1)
- . I LA7IEN,LA761 S FDA(2,69.6061,LA7IEN_","_LA7696_",",.02)=LA761
- ;
- ; File the data in the respective fields.
- I $D(FDA(1)) D
- . S LA762=$P(^LRO(69.6,LA7696,0),"^",8)
- . I LA762 S FDA(1,69.6061,"+2,"_LA7696_",",.03)=LA762
- . D UPDATE^DIE("","FDA(1)","LA76961","LA7DIE(1)")
- I $D(FDA(2)) D FILE^DIE("","FDA(2)","LA7DIE(2)")
- ;
- Q
- ;
- ;
- APDATA ; Process anatomic pathology information that accompany order (ORM) messages
- ;
- N I,FDA,LA769063,LA7DIE,LA7ERR,LA7I,LA7WP,LA7X,LA7Y,TYPE,X,Y
- ;
- S TYPE=0
- ;
- I LA7TEST(0,1)="LN" D
- . I LA7TEST="22636-5" S TYPE=.013 Q
- . I LA7TEST="10219-4" S TYPE=.014 Q
- . I LA7TEST="10215-2" S TYPE=.015 Q
- . I LA7TEST="10218-6" S TYPE=.016 Q
- . I LA7TEST="22634-0" S TYPE=1 Q
- . I LA7TEST="22635-7" D Q
- . . I LA7TEST(2,1)="99VA64",LA7TEST(2)="88569.0000" S TYPE=1.3 Q
- . . S TYPE=1.1
- . I LA7TEST="22637-3" S TYPE=1.4 Q
- . I LA7TEST="22639-9" S TYPE=1.2 Q
- ;
- I LA7TEST(0,1)="99VA64",LA7TEST="88569.0000" S TYPE=1.3
- ;
- I LA7TEST(0,1)="AS4" D
- . I LA7TEST="5000.10" S TYPE=.013 Q
- . I LA7TEST="5000.3" S TYPE=.014 Q
- . I LA7TEST="5000.4" S TYPE=.016 Q
- ;
- I LA7TEST(0,1)="99LAB",LA7TEST="FRZ" S TYPE=1.3
- ;
- ; String Data/ Formatted Text/ Text Data
- I LA7VTYP?1(1"ST",1"FT",1"TX") D
- . D PA^LA7VHLU(.LA7SEG,6,LA7FS,.LA7X)
- . D UNESCFT^LA7VHLU3(.LA7X,LA7FS_LA7ECH,.LA7WP)
- ;
- ; File the data in the respective fields.
- I TYPE,$D(LA7WP) D
- . S FDA(1,69.6063,"?+1,"_LA7696_",",.01)=TYPE
- . I LA74 S FDA(1,69.6063,"?+1,"_LA7696_",",.02)=LA74
- . D UPDATE^DIE("","FDA(1)","LA769063","LA7DIE(1)")
- . D WP^DIE(69.6063,LA769063(1)_","_LA7696_",",1,"A","LA7WP","LA7DIE(2)")
- ;
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7VIN5B 6947 printed Feb 18, 2025@23:06:52 Page 2
- LA7VIN5B ;DALOI/JMC - Process Incoming UI Msgs, continued ;11/17/11 16:09
- +1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**74**;Sep 27, 1994;Build 229
- +2 ;
- +3 ; This routine is a continuation of LA7VIN5.
- +4 ;
- +5 QUIT
- +6 ;
- +7 ;
- ORESULTS ; Process results that accompany order (ORM) messages
- +1 ;
- +2 NEW I,LA74,LA764,LA7DIE,LA7ERR,LA7I,LA7WP,LA7X,LA7Y,X,Y
- +3 ;
- +4 ; Identify producing laboratory
- +5 SET LA7X=$$P^LA7VHLU(.LA7SEG,24,LA7FS)
- SET LA74=""
- +6 IF $PIECE(LA7X,LA7CS,6)="CLIA"
- SET LA74=$$IDX^XUAF4("CLIA",$PIECE(LA7X,LA7CS,10))
- +7 IF 'LA74
- SET LA74=$$RESFID^LA7VHLU2($$P^LA7VHLU(.LA7SEG,16,LA7FS),LA7SFAC,LA7CS)
- +8 ;
- +9 ; Special handling of AP specimen codes in OBX segment.
- +10 IF LA7TEST(0,1)="LN"
- IF LA7TEST="22633-2"
- DO APSPEC
- QUIT
- +11 ;
- +12 ; Special handling of AP specimen codes in OBX segment used by DoD CHCS
- +13 IF LA7TEST(0,1)="AS4"
- IF LA7TEST="5000.12"
- DO APSPEC
- QUIT
- +14 IF LA7TEST(0,1)="99LAB"
- IF LA7TEST="TOP"
- DO APSPEC
- QUIT
- +15 ;
- +16 ; Special handling of AP data in OBX segments
- +17 IF LA7TEST(0,1)="LN"
- IF "10215-2^10218-6^10219-4^22634-0^22635-7^22636-5^22637-3^22639-9^"[LA7TEST
- DO APDATA
- QUIT
- +18 ;
- +19 ; Special handling of frozen section AP data used by VistA.
- +20 IF LA7TEST(0,1)="99VA64"
- IF LA7TEST="88569.0000"
- DO APDATA
- QUIT
- +21 ;
- +22 ; Special handling of AP data in OBX segments used by DoD CHCS.
- +23 IF LA7TEST(0,1)="AS4"
- IF "5000.3^5000.4^5000.10^"[LA7TEST
- DO APDATA
- QUIT
- +24 ;
- +25 SET LA7I=2
- SET X=""
- +26 ;
- +27 IF LA7RLNC
- Begin DoDot:1
- +28 SET X="[LOINC "_$$GET1^DIQ(95.3,LA7RLNC_",",.01)_"] "
- +29 SET Y=$$GET1^DIQ(95.3,LA7RLNC_",",81)
- +30 IF Y=""
- SET Y=$$GET1^DIQ(95.3,LA7RLNC_",",80)
- +31 SET X=X_Y
- End DoDot:1
- +32 IF 'LA7RLNC
- IF LA7RNLT
- Begin DoDot:1
- +33 SET LA764=$$FIND1^DIC(64,"","X",LA7RNLT,"E","","LA7ERR")
- +34 IF 'LA764
- SET LA7RNLT=""
- QUIT
- +35 SET X="[NLT "_$$GET1^DIQ(64,LA764_",",1)_"] "_$$GET1^DIQ(64,LA764_",",.01,"I")
- End DoDot:1
- +36 IF 'LA7RLNC
- IF 'LA7RNLT
- Begin DoDot:1
- +37 IF LA7TEST(0)]""!(LA7TEST]"")
- SET X="["_LA7TEST(0,1)_" "_LA7TEST_"] "_LA7TEST(0)
- QUIT
- +38 SET X="["_LA7TEST(2,1)_" "_LA7TEST(2)_"] "_LA7TEST(2,0)
- End DoDot:1
- +39 ;
- +40 SET LA7WP(LA7I,0)="Test result: "_X
- +41 ;
- +42 ; Date value
- +43 IF LA7VTYP?1(1"DT",1"TS")
- Begin DoDot:1
- +44 SET LA7X=$$P^LA7VHLU(.LA7SEG,6,LA7FS)
- +45 SET LA7X=$$HL7TFM^XLFDT(LA7X,"L")
- +46 SET LA7I=LA7I+1
- SET LA7WP(LA7I,0)=" Test value: "_LA7X
- End DoDot:1
- +47 ;
- +48 ; Coded entry
- +49 IF LA7VTYP?1(1"CE",1"CM",1"CNE",1"CWE")
- Begin DoDot:1
- +50 SET LA7X=$PIECE($$P^LA7VHLU(.LA7SEG,6,LA7FS),LA7CS,2)
- +51 SET LA7X=$$UNESC^LA7VHLU3(LA7X,LA7FS_LA7ECH)
- +52 SET LA7I=LA7I+1
- SET LA7WP(LA7I,0)=" Test value: "_LA7X_$SELECT(LA7UNITS'="":" "_LA7UNITS,1:"")
- End DoDot:1
- +53 ;
- +54 ; Numeric/ Structured Numeric value
- +55 IF LA7VTYP?1(1"NM",1"SN")
- Begin DoDot:1
- +56 SET LA7X=$$P^LA7VHLU(.LA7SEG,6,LA7FS)
- +57 SET LA7X=$$UNESC^LA7VHLU3(LA7X,LA7FS_LA7ECH)
- +58 SET LA7I=LA7I+1
- SET LA7WP(LA7I,0)=" Test value: "_LA7X_$SELECT(LA7UNITS]"":" "_LA7UNITS,1:"")
- End DoDot:1
- +59 ;
- +60 ; String Data/ Formatted Text/ Text Data
- +61 IF LA7VTYP?1(1"ST",1"FT",1"TX")
- Begin DoDot:1
- +62 DO PA^LA7VHLU(.LA7SEG,6,LA7FS,.LA7X)
- +63 DO UNESCFT^LA7VHLU3(.LA7X,LA7FS_LA7ECH,.LA7Y)
- +64 IF LA7Y=1
- IF (($LENGTH(LA7Y(1,0))+$LENGTH(LA7UNITS))<225)
- SET LA7I=LA7I+1
- SET LA7WP(LA7I,0)=" Test value: "_LA7Y(1,0)_$SELECT(LA7UNITS]"":" "_LA7UNITS,1:"")
- QUIT
- +65 SET LA7I=LA7I+1
- SET LA7WP(LA7I,0)=" Test value:"
- +66 FOR I=1:1:LA7Y
- SET LA7I=LA7I+1
- SET LA7WP(LA7I,0)=LA7Y(I,0)
- +67 IF LA7UNITS'=""
- SET LA7I=LA7I+1
- SET LA7WP(LA7I,0)=" Test units: "_LA7UNITS
- End DoDot:1
- +68 ;
- +69 ; Normals/ Reference range
- +70 SET LA7X=$$P^LA7VHLU(.LA7SEG,8,LA7FS)
- +71 IF LA7X'=""
- SET LA7I=LA7I+1
- SET LA7WP(LA7I,0)=" Test normals: "_LA7X
- +72 ;
- +73 ; Normalcy status
- +74 SET LA7X=$$P^LA7VHLU(.LA7SEG,9,LA7FS)
- +75 IF LA7X'=""
- Begin DoDot:1
- +76 SET X=" L^ H^LL^HH^ <^ >^ N^ A^AA^ U^ D^ B^ W^ S^ R^ I^MS^VS"
- +77 SET I=$FIND(X,LA7X)\3
- SET LA7X=$PIECE($TEXT(ABFLAGS+I^LA7VHLU1),";;",2)
- +78 IF LA7X'=""
- SET LA7I=LA7I+1
- SET LA7WP(LA7I,0)=" Test normalcy status: "_LA7X
- End DoDot:1
- +79 ;
- +80 IF $DATA(LA7WP)
- SET LA7WP(1,0)=" "
- DO WP^DIE(69.6,LA7696_",",99,"A","LA7WP","LA7DIE(99)")
- +81 QUIT
- +82 ;
- +83 ;
- APSPEC ; Process anatomic pathology specimens that accompany order (ORM) messages
- +1 ;
- +2 NEW I,FDA,LA761,LA762,LA76961,LA7ALTXT,LA7DIE,LA7IEN,LA7TXT,LA7VAL,LA7X,LA7Y
- +3 ;
- +4 SET (LA761,LA7ALTXT,LA7TXT)=""
- +5 SET LA7VAL=$$P^LA7VHLU(.LA7SEG,6,LA7FS)
- +6 ;
- +7 ; Coded entry
- +8 IF LA7VTYP?1(1"CE",1"CM",1"CNE",1"CWE")
- Begin DoDot:1
- +9 DO FLD2ARR^LA7VHLU7(.LA7VAL,LA7FS_LA7ECH)
- +10 FOR I=1,4
- Begin DoDot:2
- +11 IF $GET(LA7VAL(I+2))="SCT"
- Begin DoDot:3
- +12 NEW LA7HL7
- +13 SET LA7HL7("FSEC")=LA7FS_LA7ECH
- +14 SET LA7HL7("OBX",3)=$$P^LA7VHLU(.LA7SEG,4,LA7FS)
- +15 SET LA7HL7("OBX",5)=$$P^LA7VHLU(.LA7SEG,6,LA7FS)
- +16 SET LA761=$$SCT2IEN^LA7VHLU6(LA7VAL(I),LA7VAL(I+1),$GET(LA7VAL($SELECT(I=1:7,1:8))),61,0,LA76248)
- +17 IF 'LA761
- SET LA761=+$$EN^LRSCTX(61,LA7VAL(I+1),LA7VAL(I),.LA7HL7)
- +18 SET LA7ALTXT=LA7VAL(I+1)
- End DoDot:3
- QUIT
- +19 IF $GET(LA7VAL(I+2))=""
- IF $GET(LA7VAL(I+1))'=""
- SET LA7TXT=LA7VAL(I+1)
- End DoDot:2
- End DoDot:1
- +20 ;
- +21 IF LA7VTYP?1(1"ST",1"FT",1"TX")
- SET LA7TXT=$$UNESC^LA7VHLU3(LA7VAL,LA7FS_LA7ECH)
- +22 ;
- +23 ; Handle OBX-3 with LOINC code
- +24 IF LA7TEST(0,1)="LN"
- IF LA7TEST="22633-2"
- Begin DoDot:1
- +25 IF LA7TXT=""
- IF LA7ALTXT=""
- QUIT
- +26 SET FDA(1,69.6061,"+2,"_LA7696_",",.01)=$SELECT(LA7TXT'="":LA7TXT,1:LA7ALTXT)
- +27 IF LA761
- SET FDA(1,69.6061,"+2,"_LA7696_",",.02)=LA761
- End DoDot:1
- +28 ;
- +29 ; Handle OBX-3 with old AS4 code from HL7 standard - used by DoD CHCS
- +30 IF LA7TEST(0,1)="AS4"
- IF LA7TEST="5000.12"
- IF LA7TXT'=""
- SET FDA(1,69.6061,"+2,"_LA7696_",",.01)=LA7TXT
- +31 ;
- +32 ; Handle OBX-3 with 99LAB - used by DoD CHCS
- +33 IF LA7TEST(0,1)="99LAB"
- IF LA7TEST="TOP"
- Begin DoDot:1
- +34 NEW LA7HL7
- +35 SET LA7HL7("FSEC")=LA7FS_LA7ECH
- +36 SET LA7HL7("OBX",3)=$$P^LA7VHLU(.LA7SEG,4,LA7FS)
- +37 SET LA7HL7("OBX",5)=$$P^LA7VHLU(.LA7SEG,6,LA7FS)
- +38 IF LA7VTYP?1(1"ST",1"FT",1"TX")
- IF LA7TXT'=""
- SET FDA(1,69.6061,"+2,"_LA7696_",",.01)=LA7TXT
- QUIT
- +39 SET LA761=+$$EN^LRSCTX(61,LA7VAL,"",.LA7HL7)
- +40 SET LA7IEN=$ORDER(^LRO(69.6,LA7696,61," "),-1)
- +41 IF LA7IEN
- IF LA761
- SET FDA(2,69.6061,LA7IEN_","_LA7696_",",.02)=LA761
- End DoDot:1
- +42 ;
- +43 ; File the data in the respective fields.
- +44 IF $DATA(FDA(1))
- Begin DoDot:1
- +45 SET LA762=$PIECE(^LRO(69.6,LA7696,0),"^",8)
- +46 IF LA762
- SET FDA(1,69.6061,"+2,"_LA7696_",",.03)=LA762
- +47 DO UPDATE^DIE("","FDA(1)","LA76961","LA7DIE(1)")
- End DoDot:1
- +48 IF $DATA(FDA(2))
- DO FILE^DIE("","FDA(2)","LA7DIE(2)")
- +49 ;
- +50 QUIT
- +51 ;
- +52 ;
- APDATA ; Process anatomic pathology information that accompany order (ORM) messages
- +1 ;
- +2 NEW I,FDA,LA769063,LA7DIE,LA7ERR,LA7I,LA7WP,LA7X,LA7Y,TYPE,X,Y
- +3 ;
- +4 SET TYPE=0
- +5 ;
- +6 IF LA7TEST(0,1)="LN"
- Begin DoDot:1
- +7 IF LA7TEST="22636-5"
- SET TYPE=.013
- QUIT
- +8 IF LA7TEST="10219-4"
- SET TYPE=.014
- QUIT
- +9 IF LA7TEST="10215-2"
- SET TYPE=.015
- QUIT
- +10 IF LA7TEST="10218-6"
- SET TYPE=.016
- QUIT
- +11 IF LA7TEST="22634-0"
- SET TYPE=1
- QUIT
- +12 IF LA7TEST="22635-7"
- Begin DoDot:2
- +13 IF LA7TEST(2,1)="99VA64"
- IF LA7TEST(2)="88569.0000"
- SET TYPE=1.3
- QUIT
- +14 SET TYPE=1.1
- End DoDot:2
- QUIT
- +15 IF LA7TEST="22637-3"
- SET TYPE=1.4
- QUIT
- +16 IF LA7TEST="22639-9"
- SET TYPE=1.2
- QUIT
- End DoDot:1
- +17 ;
- +18 IF LA7TEST(0,1)="99VA64"
- IF LA7TEST="88569.0000"
- SET TYPE=1.3
- +19 ;
- +20 IF LA7TEST(0,1)="AS4"
- Begin DoDot:1
- +21 IF LA7TEST="5000.10"
- SET TYPE=.013
- QUIT
- +22 IF LA7TEST="5000.3"
- SET TYPE=.014
- QUIT
- +23 IF LA7TEST="5000.4"
- SET TYPE=.016
- QUIT
- End DoDot:1
- +24 ;
- +25 IF LA7TEST(0,1)="99LAB"
- IF LA7TEST="FRZ"
- SET TYPE=1.3
- +26 ;
- +27 ; String Data/ Formatted Text/ Text Data
- +28 IF LA7VTYP?1(1"ST",1"FT",1"TX")
- Begin DoDot:1
- +29 DO PA^LA7VHLU(.LA7SEG,6,LA7FS,.LA7X)
- +30 DO UNESCFT^LA7VHLU3(.LA7X,LA7FS_LA7ECH,.LA7WP)
- End DoDot:1
- +31 ;
- +32 ; File the data in the respective fields.
- +33 IF TYPE
- IF $DATA(LA7WP)
- Begin DoDot:1
- +34 SET FDA(1,69.6063,"?+1,"_LA7696_",",.01)=TYPE
- +35 IF LA74
- SET FDA(1,69.6063,"?+1,"_LA7696_",",.02)=LA74
- +36 DO UPDATE^DIE("","FDA(1)","LA769063","LA7DIE(1)")
- +37 DO WP^DIE(69.6063,LA769063(1)_","_LA7696_",",1,"A","LA7WP","LA7DIE(2)")
- End DoDot:1
- +38 ;
- +39 QUIT