BLRTNORD ;DATA RETRIVAL FROM LAB ORDER FOR TRANSACTION LOG ENTRY [ 09/06/2002 7:09 AM ]
;;5.2;LR;**1013**;JUL 30, 2002
;
;
Q ;EP PARAM CALL
;ORDER is the order number from ORDER/TEST STATUS in lab
;or 'C' cross reference from file 69
ORDER(ORDER) ;EP ORDER NUMBER PASSED
;returns ORDER IEN IN DT;SEQ^DT;SEQ^ if successful, -1 if not
;
N X,Y
S BLR="",X=0,U="^" F S X=$O(^LRO(69,"C",ORDER,X)) Q:+X=0 D
. S Y=0 F S Y=$O(^LRO(69,"C",ORDER,X,Y)) Q:+Y=0 S BLR=BLR_X_";"_Y_"^"
Q:'$L(BLR) -1
Q BLR
;
OLOCIEN(ORDDT,ORDIEN) ;EP ORDERING LOCATION IEN
;returns HOSP LOCATION IEN^NAME^ABBR^INST44^INST69 or -1
N IEN,NAME,ABBR,INST44,INST69,CLSTOP,CLSTOPN
S IEN=$P($G(^LRO(69,ORDDT,1,ORDIEN,0)),U,9) Q:'IEN -1
S ABBR=$P($G(^LRO(69,ORDDT,1,ORDIEN,0)),U,7)
S INST69=$P($G(^LRO(69,ORDDT,1,ORDIEN,1)),U,8)
S NAME=$P($G(^SC(IEN,0)),U,1)
S INST44=$P($G(^SC(IEN,0)),U,4)
S CLSTOP=$P($G(^SC(IEN,0)),U,7)
S:+CLSTOP CLSTOPN=$P($G(^DIC(40.7,CLSTOP,0)),U,1)
Q IEN_U_NAME_U_ABBR_U_INST44_U_INST69_U_CLSTOP_U_CLSTOPN
;
OENPRIEN(ORDDT,ORDIEN) ;EP ENCOUNTER PROVIDER IEN
;returns PROVIDER(VA200)IEN^NAME^ or -1
N IEN,NAME
S IEN=$P($G(^LRO(69,ORDDT,1,ORDIEN,0)),U,2) Q:'IEN -1
S NAME=$P($G(^VA(200,IEN,0)),U,1)
Q IEN_U_NAME
;
OPROVIEN(ORDDT,ORDIEN) ;EP ORDERING PROVIDER IEN
;returns PROVIDER(VA200)IEN^NAME^ or -1
N IEN,NAME
S IEN=$P($G(^LRO(69,ORDDT,1,ORDIEN,0)),U,6) Q:'IEN -1
S NAME=$P($G(^VA(200,IEN,0)),U,1)
Q IEN_U_NAME
;
OCOLLIEN(ORDDT,ORDIEN) ;EP ORDERING COLLECTION SAMPLE IEN
;returns COLLECTION IEN^NAME^ or -1
N IEN,NAME
S IEN=$P($G(^LRO(69,ORDDT,1,ORDIEN,0)),U,3) Q:'IEN -1
S NAME=$P($G(^LAB(62,IEN,0)),U,1)
Q IEN_U_NAME
;
OSITEIEN(ORDDT,ORDIEN) ;EP ORDERING SITE/SPECIMEN IEN
;returns SITE/SPECIMEN IEN^NAME^ MULTIPLE or -1
N IEN,NAME,X,Y
S IEN="",X=0 F S X=$O(^LRO(69,ORDDT,1,ORDIEN,4,X)) Q:+X=0 D
. S Y=$P($G(^LRO(69,ORDDT,1,ORDIEN,4,X,0)),U,1)
. S IEN=IEN_Y_";"_$P($G(^LAB(61,Y,0)),U,1)_"^"
Q:'$L(IEN) -1
Q IEN
;
OTEST(ORDDT,ORDIEN) ;EP ORDERING TEST IEN
;returns TEST(60)IEN;NAME;URG^ MULTIPLE or -1
N IEN,NAME,X,Y,URG
S IEN="",X=0 F S X=$O(^LRO(69,ORDDT,1,ORDIEN,2,X)) Q:+X=0 D
. S Y=$P($G(^LRO(69,ORDDT,1,ORDIEN,2,X,0)),U,1)
. S URG=$P($G(^LRO(69,ORDDT,1,ORDIEN,2,X,0)),U,2)
. S IEN=IEN_Y_";"_$P($G(^LAB(60,Y,0)),U,1)_";"_URG_"^"
Q:'$L(IEN) -1
Q IEN
;
OTESTIEN(ORDDT,ORDIEN) ;EP ORDERING TEST LIST
;returns TEST(60)IEN;NAME;PARENTTEST(60);URG^ MULTIPLE or -1
N IEN,NAME,X,X1,Y,Y1,Y2,Y3,Y4,Y5,PARENT,URG,BLRT,BLRSUB
TESTD ;K BLRSUB,IEN,BLRT S ORDDT=2990811,ORDIEN=1
S IEN="",(X,X1)=0 F S X=$O(^LRO(69,ORDDT,1,ORDIEN,2,X)) Q:+X=0 S (Y,Y0)=$P($G(^LRO(69,ORDDT,1,ORDIEN,2,X,0)),U,1) D
. S URG=$P($G(^LRO(69,ORDDT,1,ORDIEN,2,X,0)),U,2)
. S X1=$$TESTIEN(Y,"",URG) D SUB I +SUBC S X=0 F S X=$O(SUB(X)) Q:+X=0 S X1=$$TESTIEN(X,Y,URG) S BLRSUB(Y,X)=""
S Y=0 F S Y=$O(BLRSUB(Y)) Q:+Y=0 S Y1=0 F S Y1=$O(BLRSUB(Y,Y1)) Q:+Y1=0 S Y0=Y1 D SUB I +SUBC S X=0 F S X=$O(SUB(X)) Q:+X=0 S X1=$$TESTIEN(X,Y1,URG) S BLRSUB(Y,Y1,X)=""
S Y=0 F S Y=$O(BLRSUB(Y)) Q:+Y=0 S Y1=0 F S Y1=$O(BLRSUB(Y,Y1)) Q:+Y1=0 S Y2=0 F S Y2=$O(BLRSUB(Y,Y1,Y2)) Q:+Y2=0 S Y0=Y2 D SUB I +SUBC S X=0 F S X=$O(SUB(X)) Q:+X=0 S X1=$$TESTIEN(X,Y2,URG) S BLRSUB(Y,Y1,Y2,X)=""
S Y=0 F S Y=$O(BLRSUB(Y)) Q:+Y=0 S Y1=0 F S Y1=$O(BLRSUB(Y,Y1)) Q:+Y1=0 S Y2=0 F S Y2=$O(BLRSUB(Y,Y1,Y2)) Q:+Y2=0 D
. S Y3=0 F S Y3=$O(BLRSUB(Y,Y1,Y2,Y3)) Q:+Y3=0 S Y0=Y3 D SUB I +SUBC S X=0 F S X=$O(SUB(X)) Q:+X=0 S X1=$$TESTIEN(X,Y3,URG) S BLRSUB(Y,Y1,Y2,Y3,X)=""
S Y=0 F S Y=$O(BLRSUB(Y)) Q:+Y=0 S Y1=0 F S Y1=$O(BLRSUB(Y,Y1)) Q:+Y1=0 S Y2=0 F S Y2=$O(BLRSUB(Y,Y1,Y2)) Q:+Y2=0 S Y3=0 F S Y3=$O(BLRSUB(Y,Y1,Y2,Y3)) Q:+Y3=0 D
. S Y4=0 F S Y4=$O(BLRSUB(Y,Y1,Y2,Y3,Y4)) Q:+Y4=0 S Y0=Y4 D SUB I +SUBC S X=0 F S X=$O(SUB(X)) Q:+X=0 S X1=$$TESTIEN(X,Y4,URG) S BLRSUB(Y,Y1,Y2,Y3,Y4,X)=""
S Y=0 F S Y=$O(BLRSUB(Y)) Q:+Y=0 S Y1=0 F S Y1=$O(BLRSUB(Y,Y1)) Q:+Y1=0 S Y2=0 F S Y2=$O(BLRSUB(Y,Y1,Y2)) Q:+Y2=0 S Y3=0 F S Y3=$O(BLRSUB(Y,Y1,Y2,Y3)) Q:+Y3=0 D
. S Y4=0 F S Y4=$O(BLRSUB(Y,Y1,Y2,Y3,Y4)) Q:+Y4=0 S Y5=0 F S Y5=$O(BLRSUB(Y,Y1,Y2,Y3,Y4,Y5)) Q:+Y5=0 S Y0=Y5 D SUB I +SUBC S X=0 F S X=$O(SUB(X)) Q:+X=0 S X1=$$TESTIEN(X,Y5,URG) S BLRSUB(Y,Y1,Y2,Y3,Y4,Y5,X)=""
Q:'$L(IEN) -1
Q IEN
;
SUB ;FINDS SUB TESTS
K SUB
S (SUB,SUBC)=0 F S SUB=$O(^LAB(60,Y0,2,SUB)) Q:+SUB=0 S:$D(^LAB(60,Y0,2,SUB,0)) SUB($P($G(^LAB(60,Y0,2,SUB,0)),U))="",SUBC=SUBC+1
Q
TESTIEN(Y0,X1,URG) ;
I $D(BLRT(Y0)) Q 1
S IEN=IEN_Y0_";"_$P($G(^LAB(60,Y0,0)),U,1)_";"_X1_";"_URG_"^"
S BLRT(Y0)=""
Q 1
;
ODATE(ORDDT,ORDIEN) ;EP ORDERING DATE/TIME
;returns ORDER DATE/TIME^COLL DATE^ACC DATE^RESULTED DATE^EST COLL DATE or -1
N ODATE,CDATE,ADATE,RDATE,ECDATE
S ODATE=$P($G(^LRO(69,ORDDT,1,ORDIEN,0)),U,5) Q:'ODATE -1
S CDATE=$P($G(^LRO(69,ORDDT,1,ORDIEN,1)),U,1)
S ADATE=$P($G(^LRO(69,ORDDT,1,ORDIEN,3)),U,1)
S RDATE=$P($G(^LRO(69,ORDDT,1,ORDIEN,3)),U,2)
S ECDATE=$P($G(^LRO(69,ORDDT,1,ORDIEN,0)),U,8)
Q ODATE_U_CDATE_U_ADATE_U_RDATE_U_ECDATE
;
LRDFN(ORDDT,ORDIEN) ;EP LRDFN
;returns LRDFN^LRFILE^POINTER IEN^NAME
N LRDFN,LRFILE,DFN,NAME
S LRDFN=$P($G(^LRO(69,ORDDT,1,ORDIEN,0)),U,1) Q:'LRDFN -1
S LRFILE=$P($G(^LR(LRDFN,0)),U,2)
S DFN=$P($G(^LR(LRDFN,0)),U,3)
S:LRFILE=2 NAME=$P($G(^DPT(DFN,0)),U,1)
S:LRFILE=62.3 NAME=$P($G(^LAB(62.3,DFN,0)),U,1)
S:LRFILE=67 NAME=$P($G(^LRT(67,DFN,0)),U,1)
S:LRFILE=67.1 NAME=$P($G(^LRT(67.1,DFN,0)),U,1)
S:LRFILE=67.2 NAME=$P($G(^LRT(67.2,DFN,0)),U,1)
S:LRFILE=67.3 NAME=$P($G(^LRT(67.3,DFN,0)),U,1)
Q LRDFN_U_LRFILE_U_DFN_U_NAME
;
TEST ;TEST FUNCTIONS
S ORDER=5840
S BLR=$$ORDER(ORDER) W !,BLR
S BLR=$P(BLR,U,1)
S ORDDT=$P(BLR,";",1),ORDIEN=$P(BLR,";",2)
W !,"LRDFN = ",$$LRDFN(ORDDT,ORDIEN),!
W "LOC = ",$$OLOCIEN(ORDDT,ORDIEN),!
W "PROV = ",$$OPROVIEN(ORDDT,ORDIEN),!
W "ENPROV= ",$$OENPRIEN(ORDDT,ORDIEN),!
W "ODATE = ",$$ODATE(ORDDT,ORDIEN),!
W "COLL = ",$$OCOLLIEN(ORDDT,ORDIEN),!
W "SITE = ",$$OSITEIEN(ORDDT,ORDIEN),!
W "TEST = ",$$OTESTIEN(ORDDT,ORDIEN),!
Q
BLRTNORD ;DATA RETRIVAL FROM LAB ORDER FOR TRANSACTION LOG ENTRY [ 09/06/2002 7:09 AM ]
+1 ;;5.2;LR;**1013**;JUL 30, 2002
+2 ;
+3 ;
+4 ;EP PARAM CALL
QUIT
+5 ;ORDER is the order number from ORDER/TEST STATUS in lab
+6 ;or 'C' cross reference from file 69
ORDER(ORDER) ;EP ORDER NUMBER PASSED
+1 ;returns ORDER IEN IN DT;SEQ^DT;SEQ^ if successful, -1 if not
+2 ;
+3 NEW X,Y
+4 SET BLR=""
SET X=0
SET U="^"
FOR
SET X=$ORDER(^LRO(69,"C",ORDER,X))
IF +X=0
QUIT
Begin DoDot:1
+5 SET Y=0
FOR
SET Y=$ORDER(^LRO(69,"C",ORDER,X,Y))
IF +Y=0
QUIT
SET BLR=BLR_X_";"_Y_"^"
End DoDot:1
+6 IF '$LENGTH(BLR)
QUIT -1
+7 QUIT BLR
+8 ;
OLOCIEN(ORDDT,ORDIEN) ;EP ORDERING LOCATION IEN
+1 ;returns HOSP LOCATION IEN^NAME^ABBR^INST44^INST69 or -1
+2 NEW IEN,NAME,ABBR,INST44,INST69,CLSTOP,CLSTOPN
+3 SET IEN=$PIECE($GET(^LRO(69,ORDDT,1,ORDIEN,0)),U,9)
IF 'IEN
QUIT -1
+4 SET ABBR=$PIECE($GET(^LRO(69,ORDDT,1,ORDIEN,0)),U,7)
+5 SET INST69=$PIECE($GET(^LRO(69,ORDDT,1,ORDIEN,1)),U,8)
+6 SET NAME=$PIECE($GET(^SC(IEN,0)),U,1)
+7 SET INST44=$PIECE($GET(^SC(IEN,0)),U,4)
+8 SET CLSTOP=$PIECE($GET(^SC(IEN,0)),U,7)
+9 IF +CLSTOP
SET CLSTOPN=$PIECE($GET(^DIC(40.7,CLSTOP,0)),U,1)
+10 QUIT IEN_U_NAME_U_ABBR_U_INST44_U_INST69_U_CLSTOP_U_CLSTOPN
+11 ;
OENPRIEN(ORDDT,ORDIEN) ;EP ENCOUNTER PROVIDER IEN
+1 ;returns PROVIDER(VA200)IEN^NAME^ or -1
+2 NEW IEN,NAME
+3 SET IEN=$PIECE($GET(^LRO(69,ORDDT,1,ORDIEN,0)),U,2)
IF 'IEN
QUIT -1
+4 SET NAME=$PIECE($GET(^VA(200,IEN,0)),U,1)
+5 QUIT IEN_U_NAME
+6 ;
OPROVIEN(ORDDT,ORDIEN) ;EP ORDERING PROVIDER IEN
+1 ;returns PROVIDER(VA200)IEN^NAME^ or -1
+2 NEW IEN,NAME
+3 SET IEN=$PIECE($GET(^LRO(69,ORDDT,1,ORDIEN,0)),U,6)
IF 'IEN
QUIT -1
+4 SET NAME=$PIECE($GET(^VA(200,IEN,0)),U,1)
+5 QUIT IEN_U_NAME
+6 ;
OCOLLIEN(ORDDT,ORDIEN) ;EP ORDERING COLLECTION SAMPLE IEN
+1 ;returns COLLECTION IEN^NAME^ or -1
+2 NEW IEN,NAME
+3 SET IEN=$PIECE($GET(^LRO(69,ORDDT,1,ORDIEN,0)),U,3)
IF 'IEN
QUIT -1
+4 SET NAME=$PIECE($GET(^LAB(62,IEN,0)),U,1)
+5 QUIT IEN_U_NAME
+6 ;
OSITEIEN(ORDDT,ORDIEN) ;EP ORDERING SITE/SPECIMEN IEN
+1 ;returns SITE/SPECIMEN IEN^NAME^ MULTIPLE or -1
+2 NEW IEN,NAME,X,Y
+3 SET IEN=""
SET X=0
FOR
SET X=$ORDER(^LRO(69,ORDDT,1,ORDIEN,4,X))
IF +X=0
QUIT
Begin DoDot:1
+4 SET Y=$PIECE($GET(^LRO(69,ORDDT,1,ORDIEN,4,X,0)),U,1)
+5 SET IEN=IEN_Y_";"_$PIECE($GET(^LAB(61,Y,0)),U,1)_"^"
End DoDot:1
+6 IF '$LENGTH(IEN)
QUIT -1
+7 QUIT IEN
+8 ;
OTEST(ORDDT,ORDIEN) ;EP ORDERING TEST IEN
+1 ;returns TEST(60)IEN;NAME;URG^ MULTIPLE or -1
+2 NEW IEN,NAME,X,Y,URG
+3 SET IEN=""
SET X=0
FOR
SET X=$ORDER(^LRO(69,ORDDT,1,ORDIEN,2,X))
IF +X=0
QUIT
Begin DoDot:1
+4 SET Y=$PIECE($GET(^LRO(69,ORDDT,1,ORDIEN,2,X,0)),U,1)
+5 SET URG=$PIECE($GET(^LRO(69,ORDDT,1,ORDIEN,2,X,0)),U,2)
+6 SET IEN=IEN_Y_";"_$PIECE($GET(^LAB(60,Y,0)),U,1)_";"_URG_"^"
End DoDot:1
+7 IF '$LENGTH(IEN)
QUIT -1
+8 QUIT IEN
+9 ;
OTESTIEN(ORDDT,ORDIEN) ;EP ORDERING TEST LIST
+1 ;returns TEST(60)IEN;NAME;PARENTTEST(60);URG^ MULTIPLE or -1
+2 NEW IEN,NAME,X,X1,Y,Y1,Y2,Y3,Y4,Y5,PARENT,URG,BLRT,BLRSUB
TESTD ;K BLRSUB,IEN,BLRT S ORDDT=2990811,ORDIEN=1
+1 SET IEN=""
SET (X,X1)=0
FOR
SET X=$ORDER(^LRO(69,ORDDT,1,ORDIEN,2,X))
IF +X=0
QUIT
SET (Y,Y0)=$PIECE($GET(^LRO(69,ORDDT,1,ORDIEN,2,X,0)),U,1)
Begin DoDot:1
+2 SET URG=$PIECE($GET(^LRO(69,ORDDT,1,ORDIEN,2,X,0)),U,2)
+3 SET X1=$$TESTIEN(Y,"",URG)
DO SUB
IF +SUBC
SET X=0
FOR
SET X=$ORDER(SUB(X))
IF +X=0
QUIT
SET X1=$$TESTIEN(X,Y,URG)
SET BLRSUB(Y,X)=""
End DoDot:1
+4 SET Y=0
FOR
SET Y=$ORDER(BLRSUB(Y))
IF +Y=0
QUIT
SET Y1=0
FOR
SET Y1=$ORDER(BLRSUB(Y,Y1))
IF +Y1=0
QUIT
SET Y0=Y1
DO SUB
IF +SUBC
SET X=0
FOR
SET X=$ORDER(SUB(X))
IF +X=0
QUIT
SET X1=$$TESTIEN(X,Y1,URG)
SET BLRSUB(Y,Y1,X)=""
+5 SET Y=0
FOR
SET Y=$ORDER(BLRSUB(Y))
IF +Y=0
QUIT
SET Y1=0
FOR
SET Y1=$ORDER(BLRSUB(Y,Y1))
IF +Y1=0
QUIT
SET Y2=0
FOR
SET Y2=$ORDER(BLRSUB(Y,Y1,Y2))
IF +Y2=0
QUIT
SET Y0=Y2
DO SUB
IF +SUBC
SET X=0
FOR
SET X=$ORDER(SUB(X))
IF +X=0
QUIT
SET X1=$$TESTIEN(X,Y2,URG)
SET BLRSUB(Y,Y1,Y2,X)=""
+6 SET Y=0
FOR
SET Y=$ORDER(BLRSUB(Y))
IF +Y=0
QUIT
SET Y1=0
FOR
SET Y1=$ORDER(BLRSUB(Y,Y1))
IF +Y1=0
QUIT
SET Y2=0
FOR
SET Y2=$ORDER(BLRSUB(Y,Y1,Y2))
IF +Y2=0
QUIT
Begin DoDot:1
+7 SET Y3=0
FOR
SET Y3=$ORDER(BLRSUB(Y,Y1,Y2,Y3))
IF +Y3=0
QUIT
SET Y0=Y3
DO SUB
IF +SUBC
SET X=0
FOR
SET X=$ORDER(SUB(X))
IF +X=0
QUIT
SET X1=$$TESTIEN(X,Y3,URG)
SET BLRSUB(Y,Y1,Y2,Y3,X)=""
End DoDot:1
+8 SET Y=0
FOR
SET Y=$ORDER(BLRSUB(Y))
IF +Y=0
QUIT
SET Y1=0
FOR
SET Y1=$ORDER(BLRSUB(Y,Y1))
IF +Y1=0
QUIT
SET Y2=0
FOR
SET Y2=$ORDER(BLRSUB(Y,Y1,Y2))
IF +Y2=0
QUIT
SET Y3=0
FOR
SET Y3=$ORDER(BLRSUB(Y,Y1,Y2,Y3))
IF +Y3=0
QUIT
Begin DoDot:1
+9 SET Y4=0
FOR
SET Y4=$ORDER(BLRSUB(Y,Y1,Y2,Y3,Y4))
IF +Y4=0
QUIT
SET Y0=Y4
DO SUB
IF +SUBC
SET X=0
FOR
SET X=$ORDER(SUB(X))
IF +X=0
QUIT
SET X1=$$TESTIEN(X,Y4,URG)
SET BLRSUB(Y,Y1,Y2,Y3,Y4,X)=""
End DoDot:1
+10 SET Y=0
FOR
SET Y=$ORDER(BLRSUB(Y))
IF +Y=0
QUIT
SET Y1=0
FOR
SET Y1=$ORDER(BLRSUB(Y,Y1))
IF +Y1=0
QUIT
SET Y2=0
FOR
SET Y2=$ORDER(BLRSUB(Y,Y1,Y2))
IF +Y2=0
QUIT
SET Y3=0
FOR
SET Y3=$ORDER(BLRSUB(Y,Y1,Y2,Y3))
IF +Y3=0
QUIT
Begin DoDot:1
+11 SET Y4=0
FOR
SET Y4=$ORDER(BLRSUB(Y,Y1,Y2,Y3,Y4))
IF +Y4=0
QUIT
SET Y5=0
FOR
SET Y5=$ORDER(BLRSUB(Y,Y1,Y2,Y3,Y4,Y5))
IF +Y5=0
QUIT
SET Y0=Y5
DO SUB
IF +SUBC
SET X=0
FOR
SET X=$ORDER(SUB(X))
IF +X=0
QUIT
SET X1=$$TESTIEN(X,Y5,URG)
SET BLRSUB(Y,Y1,Y2,Y3,Y4,Y5,X)=""
End DoDot:1
+12 IF '$LENGTH(IEN)
QUIT -1
+13 QUIT IEN
+14 ;
SUB ;FINDS SUB TESTS
+1 KILL SUB
+2 SET (SUB,SUBC)=0
FOR
SET SUB=$ORDER(^LAB(60,Y0,2,SUB))
IF +SUB=0
QUIT
IF $DATA(^LAB(60,Y0,2,SUB,0))
SET SUB($PIECE($GET(^LAB(60,Y0,2,SUB,0)),U))=""
SET SUBC=SUBC+1
+3 QUIT
TESTIEN(Y0,X1,URG) ;
+1 IF $DATA(BLRT(Y0))
QUIT 1
+2 SET IEN=IEN_Y0_";"_$PIECE($GET(^LAB(60,Y0,0)),U,1)_";"_X1_";"_URG_"^"
+3 SET BLRT(Y0)=""
+4 QUIT 1
+5 ;
ODATE(ORDDT,ORDIEN) ;EP ORDERING DATE/TIME
+1 ;returns ORDER DATE/TIME^COLL DATE^ACC DATE^RESULTED DATE^EST COLL DATE or -1
+2 NEW ODATE,CDATE,ADATE,RDATE,ECDATE
+3 SET ODATE=$PIECE($GET(^LRO(69,ORDDT,1,ORDIEN,0)),U,5)
IF 'ODATE
QUIT -1
+4 SET CDATE=$PIECE($GET(^LRO(69,ORDDT,1,ORDIEN,1)),U,1)
+5 SET ADATE=$PIECE($GET(^LRO(69,ORDDT,1,ORDIEN,3)),U,1)
+6 SET RDATE=$PIECE($GET(^LRO(69,ORDDT,1,ORDIEN,3)),U,2)
+7 SET ECDATE=$PIECE($GET(^LRO(69,ORDDT,1,ORDIEN,0)),U,8)
+8 QUIT ODATE_U_CDATE_U_ADATE_U_RDATE_U_ECDATE
+9 ;
LRDFN(ORDDT,ORDIEN) ;EP LRDFN
+1 ;returns LRDFN^LRFILE^POINTER IEN^NAME
+2 NEW LRDFN,LRFILE,DFN,NAME
+3 SET LRDFN=$PIECE($GET(^LRO(69,ORDDT,1,ORDIEN,0)),U,1)
IF 'LRDFN
QUIT -1
+4 SET LRFILE=$PIECE($GET(^LR(LRDFN,0)),U,2)
+5 SET DFN=$PIECE($GET(^LR(LRDFN,0)),U,3)
+6 IF LRFILE=2
SET NAME=$PIECE($GET(^DPT(DFN,0)),U,1)
+7 IF LRFILE=62.3
SET NAME=$PIECE($GET(^LAB(62.3,DFN,0)),U,1)
+8 IF LRFILE=67
SET NAME=$PIECE($GET(^LRT(67,DFN,0)),U,1)
+9 IF LRFILE=67.1
SET NAME=$PIECE($GET(^LRT(67.1,DFN,0)),U,1)
+10 IF LRFILE=67.2
SET NAME=$PIECE($GET(^LRT(67.2,DFN,0)),U,1)
+11 IF LRFILE=67.3
SET NAME=$PIECE($GET(^LRT(67.3,DFN,0)),U,1)
+12 QUIT LRDFN_U_LRFILE_U_DFN_U_NAME
+13 ;
TEST ;TEST FUNCTIONS
+1 SET ORDER=5840
+2 SET BLR=$$ORDER(ORDER)
WRITE !,BLR
+3 SET BLR=$PIECE(BLR,U,1)
+4 SET ORDDT=$PIECE(BLR,";",1)
SET ORDIEN=$PIECE(BLR,";",2)
+5 WRITE !,"LRDFN = ",$$LRDFN(ORDDT,ORDIEN),!
+6 WRITE "LOC = ",$$OLOCIEN(ORDDT,ORDIEN),!
+7 WRITE "PROV = ",$$OPROVIEN(ORDDT,ORDIEN),!
+8 WRITE "ENPROV= ",$$OENPRIEN(ORDDT,ORDIEN),!
+9 WRITE "ODATE = ",$$ODATE(ORDDT,ORDIEN),!
+10 WRITE "COLL = ",$$OCOLLIEN(ORDDT,ORDIEN),!
+11 WRITE "SITE = ",$$OSITEIEN(ORDDT,ORDIEN),!
+12 WRITE "TEST = ",$$OTESTIEN(ORDDT,ORDIEN),!
+13 QUIT
