- 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
