LR7OFAO ;DALOI/JMC - Setup file 69 for AP orders ;02/17/17 15:58
;;5.2;LAB SERVICE;**121,350,450,462,479**;Sep 27, 1994;Build 8
;
;File 44/10040
;
Q
;
EN(LRODT,LRDFN,LRSAMP,LRORDR,LRNT,LRPRAC,LRLLOC,LRSDT,ORIFN,LRSPEC,LRSS,LRTST,LRUID,LRRECINF) ; Called from LDSI^LRAPLG1
; LRODT=Order date
; LRDFN=Patient Lab ID
; LRSAMP=Sample ptr to 62
; LRORDR=Collection type
; LRNT=d/t Ordered
; LRSDT=Start date
; ORIFN=OE/RR #
; LRSPEC=Specimen ptr to 61
; LRSS=Test subscript
; LRTST=Ordered test
; LRUID=UID
; LRRECINF:<byref> Output Array that holds the record numbers created.
;
N X,Y,LRIENLOC,LRQUIET,LRSN,LRSUM,LRIENLOC,LRLCK1,LRSTOP
N LRFDA,LRFDAIEN,LRMSG,DIERR
S LRQUIET=1 D ORDER^LROW2
; Make sure top level of File 69 is set up and cross referenced
K DIERR,LRFDAIEN,LRMSG,LRRECINF
S LRSTOP=0
S LRLCK1=$NA(^LRO(69,LRODT))
I '$D(^LRO(69,LRODT)) D ;
. S X=$$GETLOCK^LRUTIL(LRLCK1,360)
. I 'X D Q ;
. . S LRSTOP=1
. . N MSG
. . S MSG(1)="The Lab Order Entry File # 69 is in use.",MSG(1,"F")="!!"
. . S MSG(2)="Please try to file this accession again."
. . D EN^DDIOL(.MSG)
. ;
. S (LRFDAIEN(1),LRRECINF(69))=LRODT
. S LRFDA(1,69,"+1,",.01)=LRODT
. D UPDATE^DIE("S","LRFDA(1)","LRFDAIEN","LRMSG")
. I $D(LRMSG) S LRSTOP=1 D ERRMSG(.LRMSG)
;
L -@LRLCK1 ;unlock top level and proceed
I 'LRSTOP D ZSN("",.LRRECINF)
Q
;
;
ZSN(LRSN,LRRECINF) ;
; Create new LRSN entry for specimen
; Expects LRODT,LRDFN,LRAA,LRAD,LRAN
; Inputs
; LRSN: <byref><opt> Output only. See Outputs below.
; LRRECINF:<byref> See Outputs
; Outputs
; The LRSN array passed in byref is used to return the
; new LRSN value (record #)
; LRRECINF: Holds the IENs the API created. LRRECINF(69), LRRECINF(69.01), LRRECINF(69.03)
;
N LRDATA,LRLCK1,LRLCK2,LRSTOP,X,Y,R6903
N IEN,LRFDA,LRFDAIEN,LRMSG,DIERR
S LRSN=0
S LRSTOP=0
S LRLCK1=$NA(^LRO(69,LRODT,1)) ;lock SPECIMEN subfile
S X=$$GETLOCK^LRUTIL(LRLCK1,360)
I 'X D Q ;
. N MSG
. S MSG(1)="Could not lock SPECIMEN subfile.",MSG(1,"F")="!!"
. S MSG(2)="Please try to file this accession again."
. D EN^DDIOL(.MSG)
;
S IEN="+1,"_LRODT_","
S LRFDA(2,69.01,IEN,.01)=LRDFN
D UPDATE^DIE("","LRFDA(2)","LRFDAIEN","LRMSG")
I $D(LRMSG) D ;
. S LRSTOP=1
. D ERRMSG(.LRMSG)
;
L -@LRLCK1 ;unlock SPECIMEN whole file
S (LRSN,LRRECINF(69.01))=$G(LRFDAIEN(1))
I LRSTOP Q
I 'LRSN D Q ;
. N MSG
. S MSG(1)="Failed to create new SPECIMEN entry in file #69.",MSG(1,"F")="!!"
. S MSG(2)="Please try to file this accession again."
. D EN^DDIOL(.MSG)
;
; lock new SPECIMEN record just created
S LRLCK1=$NA(^LRO(69,LRODT,1,LRSN))
S X=$$GETLOCK^LRUTIL(LRLCK1,360)
I 'X D Q ;
. N MSG
. S MSG(1)="Could not lock new SPECIMEN entry "_LRSN_" in file #69.",MSG(1,"F")="!!"
. S MSG(2)="Please try to file this accession again."
. D EN^DDIOL(.MSG)
;
; Make sure Hospital Location has a value
I $G(LRLLOC)="" S LRLLOC="UNK"
K LRDATA,LRMSG,DIERR
; File 44/10040
D FIND^DIC(44,"","@","BOX",LRLLOC,"","B^C","","","LRDATA","LRMSG")
S LRIENLOC=""
S X=$O(LRDATA("DILIST",2,0))
I X S LRIENLOC=$G(LRDATA("DILIST",2,X))
I 'LRIENLOC S LRLLOC="UNK"
;
; Set entries into File 69.01
K IEN,LRFDA,LRFDAIEN,LRMSG,DIERR
S IEN=LRSN_","_LRODT_","
S LRFDA(3,69.01,IEN,9.5)=LRORD
S LRFDA(3,69.01,IEN,1)=DUZ
S LRFDA(3,69.01,IEN,3)=LRSAMP
S LRFDA(3,69.01,IEN,4)=LRORDR
S LRFDA(3,69.01,IEN,5)=LRNT
S LRFDA(3,69.01,IEN,7)=LRPRAC
S LRFDA(3,69.01,IEN,8)=LRLLOC
S LRFDA(3,69.01,IEN,5.5)=LRSDT
S LRFDA(3,69.01,IEN,23)=LRIENLOC
S LRFDA(3,69.01,IEN,.11)=ORIFN
S LRFDA(3,69.01,IEN,10)=LRSDT
I $G(LRSRDT) S LRFDA(3,69.01,IEN,20)=LRSRDT
S LRFDA(3,69.01,IEN,12)=DUZ
S LRFDA(3,69.01,IEN,13)="C"
S LRFDA(3,69.01,IEN,25)=DUZ(2)
D FILE^DIE("","LRFDA(3)","LRMSG")
I $D(LRMSG) D ;
. D ERRMSG(.LRMSG)
. S LRSTOP=1
;
; node usually set in #69.01 fld 8's Input Transform
; using FILE^DIE with external data causes a READ (from 9.2 DD node)
I 'LRSTOP S ^LR(+LRDFN,.1)=LRLLOC
;
I 'LRSTOP D
. ;;
. ; Set File #61 pointer in #69.02
. ; LRAPLGX Flag set in LRAPLG Routine
. N IEN,LRFDA,LRMSG,DIERR
. ; Set top node for 69.02 - set a single specimen entry
. I '$G(LRAPLGX) D
. . S IEN="?+1,"_LRSN_","_LRODT_","
. . S LRFDA(5,69.02,IEN,.01)=LRSPEC
. . D UPDATE^DIE("","LRFDA(5)","","LRMSG")
. . I $D(LRMSG) D ;
. . . S LRSTOP=1
. . . D ERRMSG(.LRMSG)
. I '$G(LRSTOP),$G(LRAPLGX) N IEN,IEN63,LRMSG,LRNODE,LRSPEC D
. . S IEN63=0 F S IEN63=+$O(^LR(LRDFN,LRSS,LRIDT,.1,IEN63)) Q:IEN63<1!($G(LRSTOP)) S LRNODE=^(IEN63,0) D
. . . S LRSPEC=+$P(LRNODE,U,6) Q:'LRSPEC
. . . K LRFDA,IEN
. . . S IEN="+1,"_LRSN_","_LRODT_","
. . . S LRFDA(5,69.02,IEN,.01)=LRSPEC ; Set Specimen Multiple
. . . S LRFDA(5,69.02,IEN,.02)=IEN63 ;Set instance of the specimen
. . . S LRFDA(5,69.02,IEN,1)=$P(LRNODE,U) ;Specimen Description
. . . S LRFDA(5,69.02,IEN,2)=$P(LRNODE,U,7) ;Collection Sample
. . . D UPDATE^DIE("","LRFDA(5)","","LRMSG")
. . . I $D(LRMSG) D
. . . . S LRSTOP=1
. . . . D ERRMSG(.LRMSG)
. ;;;*
;
I 'LRSTOP D ;
. ; Set data into File 68.02
. S LRLCK2=$NA(^LRO(68,1,LRAA,1,LRAD,1,LRAN))
. S X=$$GETLOCK^LRUTIL(LRLCK2,360)
. I 'X D Q ;
. . S LRSTOP=1
. . N MSG
. . S MSG(1)="Could not lock ACCESSION NUMBER entry "_LRAN_" in file #68.02.",MSG(1,"F")="!!"
. . S MSG(2)="Please try to file this accession again."
. . D EN^DDIOL(.MSG)
. ;
. K IEN,LRFDA,LRFDAIEN,LRMSG,DIERR
. S IEN=LRAN_","_LRAD_","_LRAA_","
. S LRFDA(4,68.02,IEN,3)=LRODT
. S LRFDA(4,68.02,IEN,4)=LRSN
. S LRFDA(4,68.02,IEN,14)=LRORD
. D FILE^DIE("","LRFDA(4)","LRMSG")
. I $D(LRMSG) D ;
. . S LRSTOP=1
. . D ERRMSG(.LRMSG)
. ;
;
; Set test in file 69
; Set top node for 69.03
; Already have lock (#69.01 is parent)
S R6903=0
I 'LRSTOP D ;
. K IEN,LRFDA,LRFDAIEN,LRMSG,DIERR
. S IEN="?+1,"_LRSN_","_LRODT_","
. S LRFDA(6,69.03,IEN,.01)=LRTST
. I $G(LROUTINE) S LRFDA(6,69.03,IEN,1)=LROUTINE
. S LRFDA(6,69.03,IEN,2)=LRAD
. S LRFDA(6,69.03,IEN,3)=LRAA
. S LRFDA(6,69.03,IEN,4)=LRAN
. S LRFDA(6,69.03,IEN,13)=LRUID
. ;;*
. S LRFDA(6,69.03,IEN,8)="IP" ;STATUS [IN PROCESS]
. S LRFDA(6,69.03,IEN,9)="L" ;ORIGIN OF ORDER [LAB]
. ;;;*
. D UPDATE^DIE("","LRFDA(6)","LRFDAIEN","LRMSG")
. I $D(LRMSG) D ERRMSG(.LRMSG) Q
. S (R6903,LRRECINF(69.03))=$G(LRFDAIEN(1))
. I 'R6903 D ;
. . S LRSTOP=1
. . N MSG
. . S MSG(1)="Could not create new #69.03 entry."
. . D ERRMSG()
. ;
;
I $G(LRSTOP)=0,$G(LRODT),$G(LRSN),$P($G(^LR(+$G(LRDFN),0)),U,2)=2 D
. N NATURE S NATURE="5^POLICY^99ORN"
. S:'$G(DFN) DFN=+$P(^LR(+$G(LRDFN),0),U,3)
. D NEW^LR7OB1(LRODT,LRSN,"SN",NATURE,,6) ;CALL TO UPDATE CPRS
L -@LRLCK2
L -@LRLCK1
Q
;
;
ERRMSG(LRARRAY,ARR2) ;
; Filing error notification
; Inputs
; LRARRAY: <byref><opt> FM compliant message array
; ARR2: <byref><byval><opt> Additional text
;
N MSG,I,II,J
S MSG(1)="Filing errors in routine LR7OFAO for "_LRODT_" Specimen: "_LRDFN
; Add ARR2 nodes
I $D(ARR2) D ;
. S J=+$O(MSG(" "),-1)
. I J S:J<1 J=1
. I $G(ARR2)'="" S MSG(J+1)=ARR2
. S I=0
. F S I=$O(ARR2(I)) Q:'I S J=+$O(MSG(" "),-1) S:J<1&(J) J=1 S MSG(J+1)=ARR2(I)
;
D EN^DDIOL(.MSG)
I $D(LRARRAY) D MSG^DIALOG("WE","","","","LRARRAY")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR7OFAO 7409 printed Dec 13, 2024@02:05:05 Page 2
LR7OFAO ;DALOI/JMC - Setup file 69 for AP orders ;02/17/17 15:58
+1 ;;5.2;LAB SERVICE;**121,350,450,462,479**;Sep 27, 1994;Build 8
+2 ;
+3 ;File 44/10040
+4 ;
+5 QUIT
+6 ;
EN(LRODT,LRDFN,LRSAMP,LRORDR,LRNT,LRPRAC,LRLLOC,LRSDT,ORIFN,LRSPEC,LRSS,LRTST,LRUID,LRRECINF) ; Called from LDSI^LRAPLG1
+1 ; LRODT=Order date
+2 ; LRDFN=Patient Lab ID
+3 ; LRSAMP=Sample ptr to 62
+4 ; LRORDR=Collection type
+5 ; LRNT=d/t Ordered
+6 ; LRSDT=Start date
+7 ; ORIFN=OE/RR #
+8 ; LRSPEC=Specimen ptr to 61
+9 ; LRSS=Test subscript
+10 ; LRTST=Ordered test
+11 ; LRUID=UID
+12 ; LRRECINF:<byref> Output Array that holds the record numbers created.
+13 ;
+14 NEW X,Y,LRIENLOC,LRQUIET,LRSN,LRSUM,LRIENLOC,LRLCK1,LRSTOP
+15 NEW LRFDA,LRFDAIEN,LRMSG,DIERR
+16 SET LRQUIET=1
DO ORDER^LROW2
+17 ; Make sure top level of File 69 is set up and cross referenced
+18 KILL DIERR,LRFDAIEN,LRMSG,LRRECINF
+19 SET LRSTOP=0
+20 SET LRLCK1=$NAME(^LRO(69,LRODT))
+21 ;
IF '$DATA(^LRO(69,LRODT))
Begin DoDot:1
+22 SET X=$$GETLOCK^LRUTIL(LRLCK1,360)
+23 ;
IF 'X
Begin DoDot:2
+24 SET LRSTOP=1
+25 NEW MSG
+26 SET MSG(1)="The Lab Order Entry File # 69 is in use."
SET MSG(1,"F")="!!"
+27 SET MSG(2)="Please try to file this accession again."
+28 DO EN^DDIOL(.MSG)
End DoDot:2
QUIT
+29 ;
+30 SET (LRFDAIEN(1),LRRECINF(69))=LRODT
+31 SET LRFDA(1,69,"+1,",.01)=LRODT
+32 DO UPDATE^DIE("S","LRFDA(1)","LRFDAIEN","LRMSG")
+33 IF $DATA(LRMSG)
SET LRSTOP=1
DO ERRMSG(.LRMSG)
End DoDot:1
+34 ;
+35 ;unlock top level and proceed
LOCK -@LRLCK1
+36 IF 'LRSTOP
DO ZSN("",.LRRECINF)
+37 QUIT
+38 ;
+39 ;
ZSN(LRSN,LRRECINF) ;
+1 ; Create new LRSN entry for specimen
+2 ; Expects LRODT,LRDFN,LRAA,LRAD,LRAN
+3 ; Inputs
+4 ; LRSN: <byref><opt> Output only. See Outputs below.
+5 ; LRRECINF:<byref> See Outputs
+6 ; Outputs
+7 ; The LRSN array passed in byref is used to return the
+8 ; new LRSN value (record #)
+9 ; LRRECINF: Holds the IENs the API created. LRRECINF(69), LRRECINF(69.01), LRRECINF(69.03)
+10 ;
+11 NEW LRDATA,LRLCK1,LRLCK2,LRSTOP,X,Y,R6903
+12 NEW IEN,LRFDA,LRFDAIEN,LRMSG,DIERR
+13 SET LRSN=0
+14 SET LRSTOP=0
+15 ;lock SPECIMEN subfile
SET LRLCK1=$NAME(^LRO(69,LRODT,1))
+16 SET X=$$GETLOCK^LRUTIL(LRLCK1,360)
+17 ;
IF 'X
Begin DoDot:1
+18 NEW MSG
+19 SET MSG(1)="Could not lock SPECIMEN subfile."
SET MSG(1,"F")="!!"
+20 SET MSG(2)="Please try to file this accession again."
+21 DO EN^DDIOL(.MSG)
End DoDot:1
QUIT
+22 ;
+23 SET IEN="+1,"_LRODT_","
+24 SET LRFDA(2,69.01,IEN,.01)=LRDFN
+25 DO UPDATE^DIE("","LRFDA(2)","LRFDAIEN","LRMSG")
+26 ;
IF $DATA(LRMSG)
Begin DoDot:1
+27 SET LRSTOP=1
+28 DO ERRMSG(.LRMSG)
End DoDot:1
+29 ;
+30 ;unlock SPECIMEN whole file
LOCK -@LRLCK1
+31 SET (LRSN,LRRECINF(69.01))=$GET(LRFDAIEN(1))
+32 IF LRSTOP
QUIT
+33 ;
IF 'LRSN
Begin DoDot:1
+34 NEW MSG
+35 SET MSG(1)="Failed to create new SPECIMEN entry in file #69."
SET MSG(1,"F")="!!"
+36 SET MSG(2)="Please try to file this accession again."
+37 DO EN^DDIOL(.MSG)
End DoDot:1
QUIT
+38 ;
+39 ; lock new SPECIMEN record just created
+40 SET LRLCK1=$NAME(^LRO(69,LRODT,1,LRSN))
+41 SET X=$$GETLOCK^LRUTIL(LRLCK1,360)
+42 ;
IF 'X
Begin DoDot:1
+43 NEW MSG
+44 SET MSG(1)="Could not lock new SPECIMEN entry "_LRSN_" in file #69."
SET MSG(1,"F")="!!"
+45 SET MSG(2)="Please try to file this accession again."
+46 DO EN^DDIOL(.MSG)
End DoDot:1
QUIT
+47 ;
+48 ; Make sure Hospital Location has a value
+49 IF $GET(LRLLOC)=""
SET LRLLOC="UNK"
+50 KILL LRDATA,LRMSG,DIERR
+51 ; File 44/10040
+52 DO FIND^DIC(44,"","@","BOX",LRLLOC,"","B^C","","","LRDATA","LRMSG")
+53 SET LRIENLOC=""
+54 SET X=$ORDER(LRDATA("DILIST",2,0))
+55 IF X
SET LRIENLOC=$GET(LRDATA("DILIST",2,X))
+56 IF 'LRIENLOC
SET LRLLOC="UNK"
+57 ;
+58 ; Set entries into File 69.01
+59 KILL IEN,LRFDA,LRFDAIEN,LRMSG,DIERR
+60 SET IEN=LRSN_","_LRODT_","
+61 SET LRFDA(3,69.01,IEN,9.5)=LRORD
+62 SET LRFDA(3,69.01,IEN,1)=DUZ
+63 SET LRFDA(3,69.01,IEN,3)=LRSAMP
+64 SET LRFDA(3,69.01,IEN,4)=LRORDR
+65 SET LRFDA(3,69.01,IEN,5)=LRNT
+66 SET LRFDA(3,69.01,IEN,7)=LRPRAC
+67 SET LRFDA(3,69.01,IEN,8)=LRLLOC
+68 SET LRFDA(3,69.01,IEN,5.5)=LRSDT
+69 SET LRFDA(3,69.01,IEN,23)=LRIENLOC
+70 SET LRFDA(3,69.01,IEN,.11)=ORIFN
+71 SET LRFDA(3,69.01,IEN,10)=LRSDT
+72 IF $GET(LRSRDT)
SET LRFDA(3,69.01,IEN,20)=LRSRDT
+73 SET LRFDA(3,69.01,IEN,12)=DUZ
+74 SET LRFDA(3,69.01,IEN,13)="C"
+75 SET LRFDA(3,69.01,IEN,25)=DUZ(2)
+76 DO FILE^DIE("","LRFDA(3)","LRMSG")
+77 ;
IF $DATA(LRMSG)
Begin DoDot:1
+78 DO ERRMSG(.LRMSG)
+79 SET LRSTOP=1
End DoDot:1
+80 ;
+81 ; node usually set in #69.01 fld 8's Input Transform
+82 ; using FILE^DIE with external data causes a READ (from 9.2 DD node)
+83 IF 'LRSTOP
SET ^LR(+LRDFN,.1)=LRLLOC
+84 ;
+85 IF 'LRSTOP
Begin DoDot:1
+86 ;;
+87 ; Set File #61 pointer in #69.02
+88 ; LRAPLGX Flag set in LRAPLG Routine
+89 NEW IEN,LRFDA,LRMSG,DIERR
+90 ; Set top node for 69.02 - set a single specimen entry
+91 IF '$GET(LRAPLGX)
Begin DoDot:2
+92 SET IEN="?+1,"_LRSN_","_LRODT_","
+93 SET LRFDA(5,69.02,IEN,.01)=LRSPEC
+94 DO UPDATE^DIE("","LRFDA(5)","","LRMSG")
+95 ;
IF $DATA(LRMSG)
Begin DoDot:3
+96 SET LRSTOP=1
+97 DO ERRMSG(.LRMSG)
End DoDot:3
End DoDot:2
+98 IF '$GET(LRSTOP)
IF $GET(LRAPLGX)
NEW IEN,IEN63,LRMSG,LRNODE,LRSPEC
Begin DoDot:2
+99 SET IEN63=0
FOR
SET IEN63=+$ORDER(^LR(LRDFN,LRSS,LRIDT,.1,IEN63))
if IEN63<1!($GET(LRSTOP))
QUIT
SET LRNODE=^(IEN63,0)
Begin DoDot:3
+100 SET LRSPEC=+$PIECE(LRNODE,U,6)
if 'LRSPEC
QUIT
+101 KILL LRFDA,IEN
+102 SET IEN="+1,"_LRSN_","_LRODT_","
+103 ; Set Specimen Multiple
SET LRFDA(5,69.02,IEN,.01)=LRSPEC
+104 ;Set instance of the specimen
SET LRFDA(5,69.02,IEN,.02)=IEN63
+105 ;Specimen Description
SET LRFDA(5,69.02,IEN,1)=$PIECE(LRNODE,U)
+106 ;Collection Sample
SET LRFDA(5,69.02,IEN,2)=$PIECE(LRNODE,U,7)
+107 DO UPDATE^DIE("","LRFDA(5)","","LRMSG")
+108 IF $DATA(LRMSG)
Begin DoDot:4
+109 SET LRSTOP=1
+110 DO ERRMSG(.LRMSG)
End DoDot:4
End DoDot:3
End DoDot:2
+111 ;;;*
End DoDot:1
+112 ;
+113 ;
IF 'LRSTOP
Begin DoDot:1
+114 ; Set data into File 68.02
+115 SET LRLCK2=$NAME(^LRO(68,1,LRAA,1,LRAD,1,LRAN))
+116 SET X=$$GETLOCK^LRUTIL(LRLCK2,360)
+117 ;
IF 'X
Begin DoDot:2
+118 SET LRSTOP=1
+119 NEW MSG
+120 SET MSG(1)="Could not lock ACCESSION NUMBER entry "_LRAN_" in file #68.02."
SET MSG(1,"F")="!!"
+121 SET MSG(2)="Please try to file this accession again."
+122 DO EN^DDIOL(.MSG)
End DoDot:2
QUIT
+123 ;
+124 KILL IEN,LRFDA,LRFDAIEN,LRMSG,DIERR
+125 SET IEN=LRAN_","_LRAD_","_LRAA_","
+126 SET LRFDA(4,68.02,IEN,3)=LRODT
+127 SET LRFDA(4,68.02,IEN,4)=LRSN
+128 SET LRFDA(4,68.02,IEN,14)=LRORD
+129 DO FILE^DIE("","LRFDA(4)","LRMSG")
+130 ;
IF $DATA(LRMSG)
Begin DoDot:2
+131 SET LRSTOP=1
+132 DO ERRMSG(.LRMSG)
End DoDot:2
+133 ;
End DoDot:1
+134 ;
+135 ; Set test in file 69
+136 ; Set top node for 69.03
+137 ; Already have lock (#69.01 is parent)
+138 SET R6903=0
+139 ;
IF 'LRSTOP
Begin DoDot:1
+140 KILL IEN,LRFDA,LRFDAIEN,LRMSG,DIERR
+141 SET IEN="?+1,"_LRSN_","_LRODT_","
+142 SET LRFDA(6,69.03,IEN,.01)=LRTST
+143 IF $GET(LROUTINE)
SET LRFDA(6,69.03,IEN,1)=LROUTINE
+144 SET LRFDA(6,69.03,IEN,2)=LRAD
+145 SET LRFDA(6,69.03,IEN,3)=LRAA
+146 SET LRFDA(6,69.03,IEN,4)=LRAN
+147 SET LRFDA(6,69.03,IEN,13)=LRUID
+148 ;;*
+149 ;STATUS [IN PROCESS]
SET LRFDA(6,69.03,IEN,8)="IP"
+150 ;ORIGIN OF ORDER [LAB]
SET LRFDA(6,69.03,IEN,9)="L"
+151 ;;;*
+152 DO UPDATE^DIE("","LRFDA(6)","LRFDAIEN","LRMSG")
+153 IF $DATA(LRMSG)
DO ERRMSG(.LRMSG)
QUIT
+154 SET (R6903,LRRECINF(69.03))=$GET(LRFDAIEN(1))
+155 ;
IF 'R6903
Begin DoDot:2
+156 SET LRSTOP=1
+157 NEW MSG
+158 SET MSG(1)="Could not create new #69.03 entry."
+159 DO ERRMSG()
End DoDot:2
+160 ;
End DoDot:1
+161 ;
+162 IF $GET(LRSTOP)=0
IF $GET(LRODT)
IF $GET(LRSN)
IF $PIECE($GET(^LR(+$GET(LRDFN),0)),U,2)=2
Begin DoDot:1
+163 NEW NATURE
SET NATURE="5^POLICY^99ORN"
+164 if '$GET(DFN)
SET DFN=+$PIECE(^LR(+$GET(LRDFN),0),U,3)
+165 ;CALL TO UPDATE CPRS
DO NEW^LR7OB1(LRODT,LRSN,"SN",NATURE,,6)
End DoDot:1
+166 LOCK -@LRLCK2
+167 LOCK -@LRLCK1
+168 QUIT
+169 ;
+170 ;
ERRMSG(LRARRAY,ARR2) ;
+1 ; Filing error notification
+2 ; Inputs
+3 ; LRARRAY: <byref><opt> FM compliant message array
+4 ; ARR2: <byref><byval><opt> Additional text
+5 ;
+6 NEW MSG,I,II,J
+7 SET MSG(1)="Filing errors in routine LR7OFAO for "_LRODT_" Specimen: "_LRDFN
+8 ; Add ARR2 nodes
+9 ;
IF $DATA(ARR2)
Begin DoDot:1
+10 SET J=+$ORDER(MSG(" "),-1)
+11 IF J
if J<1
SET J=1
+12 IF $GET(ARR2)'=""
SET MSG(J+1)=ARR2
+13 SET I=0
+14 FOR
SET I=$ORDER(ARR2(I))
if 'I
QUIT
SET J=+$ORDER(MSG(" "),-1)
if J<1&(J)
SET J=1
SET MSG(J+1)=ARR2(I)
End DoDot:1
+15 ;
+16 DO EN^DDIOL(.MSG)
+17 IF $DATA(LRARRAY)
DO MSG^DIALOG("WE","","","","LRARRAY")
+18 QUIT
