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 Oct 16, 2024@17:41:20 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
