LA7VIN2A ;DALOI/JMC - Process Incoming UI Msgs, continued ;12/20/16 11:20
;;5.2;AUTOMATED LAB INSTRUMENTS;**74,88,90,96**;Sep 27, 1994;Build 2
;
;This routine is a continuation of LA7VIN2 and is only called from there.
Q
;
NTE ; Process NTE segment
; NTE segments contain comments from instruments or other facilities.
; NTE segments following OBR's contain comments which refer to the entire test battery.
; NTE segments following OBX's contain comments which are test specific.
;
; For comments in ORU messages:
; Test specific comments can be prefaced with a site defined prefix -
; see field REMARK PREFIX (#19) in CHEM TEST multiple of AUTOMATED INSTRUMENT (#62.4 file.
; There can be more than one NTE, each will be stored as a comment in ^LAH.
;
N LA7,LA7CMTYP,LA7I,LA7NTE,LA7SOC,X,Y
;
S LA7SOC=$$P^LA7VHLU(.LA7SEG,3,LA7FS)
S LA7NTE=$$P^LA7VHLU(.LA7SEG,4,LA7FS)
S LA7CMTYP=$$P^LA7VHLU(.LA7SEG,5,LA7FS)
D FLD2ARR^LA7VHLU7(.LA7CMTYP,LA7FS_LA7ECH)
;
; Trim trailing spaces.
I LA7NTE'="" S LA7NTE=$$TRIM^XLFSTR(LA7NTE,"R"," ")
I LA7NTE="" S LA7NTE=" "
;
I LA7MTYP="ORM" D OCOM Q
;
; Check for repeating comments in NTE segment and process
; If "^" in remark then translate to "~" to store.
F LA7I=1:1:$L(LA7NTE,$E(LA7ECH,2)) D
. S LA7RMK=$P(LA7NTE,$E(LA7ECH,2),LA7I)
. I LA7RMK="" Q
. S LA7RMK=$$UNESC^LA7VHLU3(LA7RMK,LA7FS_LA7ECH)
. I LA7RMK["^" S LA7RMK=$TR(LA7RMK,"^","~")
. I LA7MTYP="ORU" D RCOM Q
. I LA7MTYP="ORR",$G(LA7OTYPE)="UA" D RCOM Q
;
; Clean up LA7RMK except for LA7RMK(0)
K X M X=LA7RMK(0) K LA7RMK M LA7RMK(0)=X
;
Q
;
;
RCOM ; Store result comments in ORU messages
;
; Check there's pointers to LAH
I $G(LA7LWL)=""!($G(LA7ISQN)="") Q
;
; Don't store remark if same as specimen comment (without "~").
I $G(LA7AA),$G(LA7AD),$G(LA7AN),LA7RMK=$TR($P($G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,3)),"^",6),"~") Q
; Or patient info (#.091 in file 63) - info previously downloaded
I $G(LA7AA),$G(LA7AD),$G(LA7AN),LA7RMK=$G(^LR(+$G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,0)),.091)) Q
;
; If test specific, store comment prefix with comments (see LA7VIN5)
I $G(LA7SS)="CH",$O(LA7RMK(0,0)) D Q
. N LA7I
. S LA7I=0
. F S LA7I=$O(LA7RMK(0,LA7I)) Q:'LA7I D
. . I $G(LA7AUTORELEASE) D RMKSET^LASET(LA7LWL,LA7ISQN,LA7RMK,$P(LA7RMK(0,LA7I),"^",2)) Q
. . I '$P(LA7RMK(0,LA7I),"^") Q
. . ; Don't store if status not "FINAL"
. . I $P(LA7RMK(0,LA7I),"^")=2,"CFUX"'[$G(LA7ORS) Q
. . D RMKSET^LASET(LA7LWL,LA7ISQN,LA7RMK,$P(LA7RMK(0,LA7I),"^",2))
;
; Store comment in 1 node of ^LAH global
I $G(LA7SS)="CH" D Q
. I $P(LA7624(0),"^",17)!($G(LA7AUTORELEASE)) D RMKSET^LASET(LA7LWL,LA7ISQN,LA7RMK,"")
;
; Store "MI" subscript comments/remarks in specific places.
; - Don't store comments from ORR messages - handled by mail bulletin
I $G(LA7SS)="MI",LA7MTYP'="ORR" D Q
. N LA7ISQN2,LA7ISQN3,LA7ISQN4,LA7ND,LACONCPT,LAPREFIX
. S (LA7ISQN2,LA7ISQN3,LA7ISQN4,LA7ND)=""
. I $G(LA7CMTYP(3))="HL70364",$E($G(LA7CMTYP(1)),1,7)="VA-LRMI" D MISPC
. S LACONCPT=$P($G(LA7RMK(0,0)),"^"),LAPREFIX=$P($G(LA7RMK(0,0)),"^",3)
. D MICMT,UPD0
;
; Store AP subscripts comments/remarks in specific places.
; - Don't store comments from ORR messages - handled by mail bulletin
I $G(LA7SS)'="","SPCYEM"[LA7SS,LA7MTYP'="ORR" D Q
. N LA7ISQN2,LAPREFIX
. S LA7ND=99,LAPREFIX=$P($G(LA7RMK(0,0)),"^",3),(LA7ISQN2,LA7ISQN3,LA7ISQN4)=""
. S LA7ISQN2=$O(^LAH(LA7LWL,1,LA7ISQN,LA7SS,99,"A"),-1)+1
. S ^LAH(LWL,1,LA7ISQN,LA7SS,99,LA7ISQN2,0)=LAPREFIX_LA7RMK
. D UPD0
;
Q
;
;
OCOM ; Store order comments from ORM messages in file #69.6
; Check for repeating comments in NTE segment and process
; If "^" in remark then translate to "~" to store.
;
; If source of comment (LA7SOC) is "RQ" then comment is from CHCS which
; uses a composite data type for NTE-3. VistA only extracts component #9
; which contains the external value of the comment.
;
N LA7DIE,LA7RMK,LA7WP,X
I $G(LA7696)<1 Q
F LA7I=1:1:$L(LA7NTE,$E(LA7ECH,2)) D
. S LA7RMK=$P(LA7NTE,$E(LA7ECH,2),LA7I)
. I LA7SOC="RQ" D
. . S X=$P(LA7RMK,$E(LA7ECH),9)
. . I X'="" S LA7RMK=X
. I LA7RMK="" Q
. S LA7RMK=$$UNESC^LA7VHLU3(LA7RMK,LA7FS_LA7ECH)
. I LA7RMK["^" S LA7RMK=$TR(LA7RMK,"^","~")
. S LA7WP(LA7I,0)=LA7RMK
D WP^DIE(69.6,LA7696_",",99,"A","LA7WP","LA7DIE(99)")
Q
;
;
MISPC ; Process special VistA Lab MI preliminary reports/test/remarks comment types
;
N LA7I
S LA7I=+$E(LA7CMTYP(1),8,99)
;
; Comment on Specimen: VA-LRMI001 node = 99
; Bacterial preliminary/report/tests remark: VA-LRMI010:VA-LRMI013 nodes = 4,19,26,25
; Parasite preliminary/report/tests remark: VA-LRMI020:VA-LRMI023 nodes = 7,21,27,24
; Fungal preliminary/report/tests remark: VA-LRMI030:VA-LRMI033 nodes = 10,22,28,15
; Mycobacteria preliminary/report/tests remark: VA-LRMI040:VA-LRMI042 nodes = 13,23,29
; Viral preliminary/report/tests remark: VA-LRMI050:VA-LRMI052 nodes = 18,20,30
; Sterility Results: VA-LRMI060 node = 31
;
S LA7ND=$P("99^^^^^^^^^4^19^26^25^^^^^^^7^21^27^24^^^^^^^10^22^28^15^^^^^^^13^23^29^^^^^^^^18^20^30^^^^^^^^31","^",LA7I)
;
Q
;
;
MICMT ; Store MI comments/remarks
; From above
I LACONCPT=13 D Q
. S LA7ND=6,LA7ISQN2=$P($P(LA7RMK(0,0),"^",2),","),LA7ISQN3=$P($P(LA7RMK(0,0),"^",2),",",2)
. S LA7ISQN4=$O(^LAH(LWL,1,LA7ISQN,"MI",6,LA7ISQN2,1,LA7ISQN3,1,"A"),-1)+1
. S ^LAH(LWL,1,LA7ISQN,"MI",6,LA7ISQN2,1,LA7ISQN3,1,LA7ISQN4,0)=LAPREFIX_LA7RMK
;
I LACONCPT=3!(LACONCPT=7)!(LACONCPT=10)!(LACONCPT=4)!(LACONCPT=9) D Q
. S LA7ND=$S(LACONCPT=4:12,LACONCPT=9:9,1:3)
. S LA7ISQN2=$P($P(LA7RMK(0,0),"^",2),","),LA7ISQN3=$O(^LAH(LWL,1,LA7ISQN,"MI",LA7ND,LA7ISQN2,1,"A"),-1)+1
. S ^LAH(LWL,1,LA7ISQN,"MI",LA7ND,LA7ISQN2,1,LA7ISQN3,0)=LAPREFIX_LA7RMK
;
; Store all other concepts here.
I LA7ND="" S LA7ND=$S(LACONCPT<2:4,LACONCPT=12:7,LACONCPT=15:10,LACONCPT=22:13,LACONCPT=79:13,LACONCPT=85:13,LACONCPT=30:18,1:4)
S LA7ISQN2=$O(^LAH(LWL,1,LA7ISQN,"MI",LA7ND,"A"),-1)+1
S ^LAH(LWL,1,LA7ISQN,"MI",LA7ND,LA7ISQN2,0)=LAPREFIX_LA7RMK
;
Q
;
;
UPD0 ; Update the remarks/comments zeroth node with status
;
N LA7STAT,LA7PL,LA7X
;
; Don't update status/performing lab when processing Lab UI interface (1) messages.
; User releasing report indicates status and performing lab.
I LA7INTYP=1 Q
;
; Attempt to identify performing lab from OBX-15 (NTE following OBX) or OBR-32 (NTE following OBR)
S LA7PL=$G(LA7PRODID)
I LA7PL="",$G(LA7OBR32(7))'="" S LA7PL=$$RESFID^LA7VHLU2(LA7OBR32(7),LA7SFAC,LA7CS)
;
S LA7STAT=$S($G(LA7ORS)'="":LA7ORS,1:$G(LA7OBR25))
;
I LA7ISQN4 D Q
. I LA7PL'="" S $P(^LAH(LWL,1,LA7ISQN,LA7SS,LA7ND,LA7ISQN2,1,LA7ISQN3,1,0),"^")=LA7PL
. I $P($G(^LAH(LWL,1,LA7ISQN,LA7SS,LA7ND,LA7ISQN2,1,LA7ISQN3,0)),"^",4)'="" Q
. I LA7STAT'="" S $P(^LAH(LWL,1,LA7ISQN,LA7SS,LA7ND,LA7ISQN2,1,LA7ISQN3,1,0),"^",4)=LA7STAT
;
I LA7ISQN3 D Q
. I LA7PL'="" S $P(^LAH(LWL,1,LA7ISQN,LA7SS,LA7ND,LA7ISQN2,1,0),"^")=LA7PL
. I $P($G(^LAH(LWL,1,LA7ISQN,LA7SS,LA7ND,LA7ISQN2,0)),"^",4)'="" Q
. S $P(^LAH(LWL,1,LA7ISQN,LA7SS,LA7ND,LA7ISQN2,1,0),"^",4)=LA7STAT
;
I LA7ISQN2 D Q
. I LA7PL'="" S $P(^LAH(LWL,1,LA7ISQN,LA7SS,LA7ND,0),"^")=LA7PL
. I $P($G(^LAH(LWL,1,LA7ISQN,LA7SS,LA7ND,0)),"^",4)'="" Q
. S $P(^LAH(LWL,1,LA7ISQN,LA7SS,LA7ND,0),"^",4)=LA7STAT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7VIN2A 7406 printed Apr 09, 2024@20:43:43 Page 2
LA7VIN2A ;DALOI/JMC - Process Incoming UI Msgs, continued ;12/20/16 11:20
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**74,88,90,96**;Sep 27, 1994;Build 2
+2 ;
+3 ;This routine is a continuation of LA7VIN2 and is only called from there.
+4 QUIT
+5 ;
NTE ; Process NTE segment
+1 ; NTE segments contain comments from instruments or other facilities.
+2 ; NTE segments following OBR's contain comments which refer to the entire test battery.
+3 ; NTE segments following OBX's contain comments which are test specific.
+4 ;
+5 ; For comments in ORU messages:
+6 ; Test specific comments can be prefaced with a site defined prefix -
+7 ; see field REMARK PREFIX (#19) in CHEM TEST multiple of AUTOMATED INSTRUMENT (#62.4 file.
+8 ; There can be more than one NTE, each will be stored as a comment in ^LAH.
+9 ;
+10 NEW LA7,LA7CMTYP,LA7I,LA7NTE,LA7SOC,X,Y
+11 ;
+12 SET LA7SOC=$$P^LA7VHLU(.LA7SEG,3,LA7FS)
+13 SET LA7NTE=$$P^LA7VHLU(.LA7SEG,4,LA7FS)
+14 SET LA7CMTYP=$$P^LA7VHLU(.LA7SEG,5,LA7FS)
+15 DO FLD2ARR^LA7VHLU7(.LA7CMTYP,LA7FS_LA7ECH)
+16 ;
+17 ; Trim trailing spaces.
+18 IF LA7NTE'=""
SET LA7NTE=$$TRIM^XLFSTR(LA7NTE,"R"," ")
+19 IF LA7NTE=""
SET LA7NTE=" "
+20 ;
+21 IF LA7MTYP="ORM"
DO OCOM
QUIT
+22 ;
+23 ; Check for repeating comments in NTE segment and process
+24 ; If "^" in remark then translate to "~" to store.
+25 FOR LA7I=1:1:$LENGTH(LA7NTE,$EXTRACT(LA7ECH,2))
Begin DoDot:1
+26 SET LA7RMK=$PIECE(LA7NTE,$EXTRACT(LA7ECH,2),LA7I)
+27 IF LA7RMK=""
QUIT
+28 SET LA7RMK=$$UNESC^LA7VHLU3(LA7RMK,LA7FS_LA7ECH)
+29 IF LA7RMK["^"
SET LA7RMK=$TRANSLATE(LA7RMK,"^","~")
+30 IF LA7MTYP="ORU"
DO RCOM
QUIT
+31 IF LA7MTYP="ORR"
IF $GET(LA7OTYPE)="UA"
DO RCOM
QUIT
End DoDot:1
+32 ;
+33 ; Clean up LA7RMK except for LA7RMK(0)
+34 KILL X
MERGE X=LA7RMK(0)
KILL LA7RMK
MERGE LA7RMK(0)=X
+35 ;
+36 QUIT
+37 ;
+38 ;
RCOM ; Store result comments in ORU messages
+1 ;
+2 ; Check there's pointers to LAH
+3 IF $GET(LA7LWL)=""!($GET(LA7ISQN)="")
QUIT
+4 ;
+5 ; Don't store remark if same as specimen comment (without "~").
+6 IF $GET(LA7AA)
IF $GET(LA7AD)
IF $GET(LA7AN)
IF LA7RMK=$TRANSLATE($PIECE($GET(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,3)),"^",6),"~")
QUIT
+7 ; Or patient info (#.091 in file 63) - info previously downloaded
+8 IF $GET(LA7AA)
IF $GET(LA7AD)
IF $GET(LA7AN)
IF LA7RMK=$GET(^LR(+$GET(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,0)),.091))
QUIT
+9 ;
+10 ; If test specific, store comment prefix with comments (see LA7VIN5)
+11 IF $GET(LA7SS)="CH"
IF $ORDER(LA7RMK(0,0))
Begin DoDot:1
+12 NEW LA7I
+13 SET LA7I=0
+14 FOR
SET LA7I=$ORDER(LA7RMK(0,LA7I))
if 'LA7I
QUIT
Begin DoDot:2
+15 IF $GET(LA7AUTORELEASE)
DO RMKSET^LASET(LA7LWL,LA7ISQN,LA7RMK,$PIECE(LA7RMK(0,LA7I),"^",2))
QUIT
+16 IF '$PIECE(LA7RMK(0,LA7I),"^")
QUIT
+17 ; Don't store if status not "FINAL"
+18 IF $PIECE(LA7RMK(0,LA7I),"^")=2
IF "CFUX"'[$GET(LA7ORS)
QUIT
+19 DO RMKSET^LASET(LA7LWL,LA7ISQN,LA7RMK,$PIECE(LA7RMK(0,LA7I),"^",2))
End DoDot:2
End DoDot:1
QUIT
+20 ;
+21 ; Store comment in 1 node of ^LAH global
+22 IF $GET(LA7SS)="CH"
Begin DoDot:1
+23 IF $PIECE(LA7624(0),"^",17)!($GET(LA7AUTORELEASE))
DO RMKSET^LASET(LA7LWL,LA7ISQN,LA7RMK,"")
End DoDot:1
QUIT
+24 ;
+25 ; Store "MI" subscript comments/remarks in specific places.
+26 ; - Don't store comments from ORR messages - handled by mail bulletin
+27 IF $GET(LA7SS)="MI"
IF LA7MTYP'="ORR"
Begin DoDot:1
+28 NEW LA7ISQN2,LA7ISQN3,LA7ISQN4,LA7ND,LACONCPT,LAPREFIX
+29 SET (LA7ISQN2,LA7ISQN3,LA7ISQN4,LA7ND)=""
+30 IF $GET(LA7CMTYP(3))="HL70364"
IF $EXTRACT($GET(LA7CMTYP(1)),1,7)="VA-LRMI"
DO MISPC
+31 SET LACONCPT=$PIECE($GET(LA7RMK(0,0)),"^")
SET LAPREFIX=$PIECE($GET(LA7RMK(0,0)),"^",3)
+32 DO MICMT
DO UPD0
End DoDot:1
QUIT
+33 ;
+34 ; Store AP subscripts comments/remarks in specific places.
+35 ; - Don't store comments from ORR messages - handled by mail bulletin
+36 IF $GET(LA7SS)'=""
IF "SPCYEM"[LA7SS
IF LA7MTYP'="ORR"
Begin DoDot:1
+37 NEW LA7ISQN2,LAPREFIX
+38 SET LA7ND=99
SET LAPREFIX=$PIECE($GET(LA7RMK(0,0)),"^",3)
SET (LA7ISQN2,LA7ISQN3,LA7ISQN4)=""
+39 SET LA7ISQN2=$ORDER(^LAH(LA7LWL,1,LA7ISQN,LA7SS,99,"A"),-1)+1
+40 SET ^LAH(LWL,1,LA7ISQN,LA7SS,99,LA7ISQN2,0)=LAPREFIX_LA7RMK
+41 DO UPD0
End DoDot:1
QUIT
+42 ;
+43 QUIT
+44 ;
+45 ;
OCOM ; Store order comments from ORM messages in file #69.6
+1 ; Check for repeating comments in NTE segment and process
+2 ; If "^" in remark then translate to "~" to store.
+3 ;
+4 ; If source of comment (LA7SOC) is "RQ" then comment is from CHCS which
+5 ; uses a composite data type for NTE-3. VistA only extracts component #9
+6 ; which contains the external value of the comment.
+7 ;
+8 NEW LA7DIE,LA7RMK,LA7WP,X
+9 IF $GET(LA7696)<1
QUIT
+10 FOR LA7I=1:1:$LENGTH(LA7NTE,$EXTRACT(LA7ECH,2))
Begin DoDot:1
+11 SET LA7RMK=$PIECE(LA7NTE,$EXTRACT(LA7ECH,2),LA7I)
+12 IF LA7SOC="RQ"
Begin DoDot:2
+13 SET X=$PIECE(LA7RMK,$EXTRACT(LA7ECH),9)
+14 IF X'=""
SET LA7RMK=X
End DoDot:2
+15 IF LA7RMK=""
QUIT
+16 SET LA7RMK=$$UNESC^LA7VHLU3(LA7RMK,LA7FS_LA7ECH)
+17 IF LA7RMK["^"
SET LA7RMK=$TRANSLATE(LA7RMK,"^","~")
+18 SET LA7WP(LA7I,0)=LA7RMK
End DoDot:1
+19 DO WP^DIE(69.6,LA7696_",",99,"A","LA7WP","LA7DIE(99)")
+20 QUIT
+21 ;
+22 ;
MISPC ; Process special VistA Lab MI preliminary reports/test/remarks comment types
+1 ;
+2 NEW LA7I
+3 SET LA7I=+$EXTRACT(LA7CMTYP(1),8,99)
+4 ;
+5 ; Comment on Specimen: VA-LRMI001 node = 99
+6 ; Bacterial preliminary/report/tests remark: VA-LRMI010:VA-LRMI013 nodes = 4,19,26,25
+7 ; Parasite preliminary/report/tests remark: VA-LRMI020:VA-LRMI023 nodes = 7,21,27,24
+8 ; Fungal preliminary/report/tests remark: VA-LRMI030:VA-LRMI033 nodes = 10,22,28,15
+9 ; Mycobacteria preliminary/report/tests remark: VA-LRMI040:VA-LRMI042 nodes = 13,23,29
+10 ; Viral preliminary/report/tests remark: VA-LRMI050:VA-LRMI052 nodes = 18,20,30
+11 ; Sterility Results: VA-LRMI060 node = 31
+12 ;
+13 SET LA7ND=$PIECE("99^^^^^^^^^4^19^26^25^^^^^^^7^21^27^24^^^^^^^10^22^28^15^^^^^^^13^23^29^^^^^^^^18^20^30^^^^^^^^31","^",LA7I)
+14 ;
+15 QUIT
+16 ;
+17 ;
MICMT ; Store MI comments/remarks
+1 ; From above
+2 IF LACONCPT=13
Begin DoDot:1
+3 SET LA7ND=6
SET LA7ISQN2=$PIECE($PIECE(LA7RMK(0,0),"^",2),",")
SET LA7ISQN3=$PIECE($PIECE(LA7RMK(0,0),"^",2),",",2)
+4 SET LA7ISQN4=$ORDER(^LAH(LWL,1,LA7ISQN,"MI",6,LA7ISQN2,1,LA7ISQN3,1,"A"),-1)+1
+5 SET ^LAH(LWL,1,LA7ISQN,"MI",6,LA7ISQN2,1,LA7ISQN3,1,LA7ISQN4,0)=LAPREFIX_LA7RMK
End DoDot:1
QUIT
+6 ;
+7 IF LACONCPT=3!(LACONCPT=7)!(LACONCPT=10)!(LACONCPT=4)!(LACONCPT=9)
Begin DoDot:1
+8 SET LA7ND=$SELECT(LACONCPT=4:12,LACONCPT=9:9,1:3)
+9 SET LA7ISQN2=$PIECE($PIECE(LA7RMK(0,0),"^",2),",")
SET LA7ISQN3=$ORDER(^LAH(LWL,1,LA7ISQN,"MI",LA7ND,LA7ISQN2,1,"A"),-1)+1
+10 SET ^LAH(LWL,1,LA7ISQN,"MI",LA7ND,LA7ISQN2,1,LA7ISQN3,0)=LAPREFIX_LA7RMK
End DoDot:1
QUIT
+11 ;
+12 ; Store all other concepts here.
+13 IF LA7ND=""
SET LA7ND=$SELECT(LACONCPT<2:4,LACONCPT=12:7,LACONCPT=15:10,LACONCPT=22:13,LACONCPT=79:13,LACONCPT=85:13,LACONCPT=30:18,1:4)
+14 SET LA7ISQN2=$ORDER(^LAH(LWL,1,LA7ISQN,"MI",LA7ND,"A"),-1)+1
+15 SET ^LAH(LWL,1,LA7ISQN,"MI",LA7ND,LA7ISQN2,0)=LAPREFIX_LA7RMK
+16 ;
+17 QUIT
+18 ;
+19 ;
UPD0 ; Update the remarks/comments zeroth node with status
+1 ;
+2 NEW LA7STAT,LA7PL,LA7X
+3 ;
+4 ; Don't update status/performing lab when processing Lab UI interface (1) messages.
+5 ; User releasing report indicates status and performing lab.
+6 IF LA7INTYP=1
QUIT
+7 ;
+8 ; Attempt to identify performing lab from OBX-15 (NTE following OBX) or OBR-32 (NTE following OBR)
+9 SET LA7PL=$GET(LA7PRODID)
+10 IF LA7PL=""
IF $GET(LA7OBR32(7))'=""
SET LA7PL=$$RESFID^LA7VHLU2(LA7OBR32(7),LA7SFAC,LA7CS)
+11 ;
+12 SET LA7STAT=$SELECT($GET(LA7ORS)'="":LA7ORS,1:$GET(LA7OBR25))
+13 ;
+14 IF LA7ISQN4
Begin DoDot:1
+15 IF LA7PL'=""
SET $PIECE(^LAH(LWL,1,LA7ISQN,LA7SS,LA7ND,LA7ISQN2,1,LA7ISQN3,1,0),"^")=LA7PL
+16 IF $PIECE($GET(^LAH(LWL,1,LA7ISQN,LA7SS,LA7ND,LA7ISQN2,1,LA7ISQN3,0)),"^",4)'=""
QUIT
+17 IF LA7STAT'=""
SET $PIECE(^LAH(LWL,1,LA7ISQN,LA7SS,LA7ND,LA7ISQN2,1,LA7ISQN3,1,0),"^",4)=LA7STAT
End DoDot:1
QUIT
+18 ;
+19 IF LA7ISQN3
Begin DoDot:1
+20 IF LA7PL'=""
SET $PIECE(^LAH(LWL,1,LA7ISQN,LA7SS,LA7ND,LA7ISQN2,1,0),"^")=LA7PL
+21 IF $PIECE($GET(^LAH(LWL,1,LA7ISQN,LA7SS,LA7ND,LA7ISQN2,0)),"^",4)'=""
QUIT
+22 SET $PIECE(^LAH(LWL,1,LA7ISQN,LA7SS,LA7ND,LA7ISQN2,1,0),"^",4)=LA7STAT
End DoDot:1
QUIT
+23 ;
+24 IF LA7ISQN2
Begin DoDot:1
+25 IF LA7PL'=""
SET $PIECE(^LAH(LWL,1,LA7ISQN,LA7SS,LA7ND,0),"^")=LA7PL
+26 IF $PIECE($GET(^LAH(LWL,1,LA7ISQN,LA7SS,LA7ND,0)),"^",4)'=""
QUIT
+27 SET $PIECE(^LAH(LWL,1,LA7ISQN,LA7SS,LA7ND,0),"^",4)=LA7STAT
End DoDot:1
QUIT
+28 QUIT
