BLRLNKU2.m

BLRLNKU2 ;IHS/OIT/MKK - IHS LABORATORY PCC Utilities 2; 03-Oct-2016 10:42 ; MKK

 ;;5.2;IHS LABORATORY;**1039**;NOV 01, 1997;Build 38

 ;

ADDORDL(BLRLOGDA,APCDALVR) ; EP - Add ORDERING LOCATION to APCDALVR array if missing

 NEW (APCDALVR,BLRLOGDA,DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)

 S ORDLOC=$$GET1^DIQ(9009022,BLRLOGDA,1106,"I")

 Q:ORDLOC

 ;

 S LRAS=$$GET1^DIQ(9009022,BLRLOGDA,1202)

 Q:$L(LRAS)<1

 ;

 Q:$$GETACCCP^BLRUTIL3(LRAS,.LRAA,.LRAD,.LRAN)<1

 Q:LRAA<1!(LRAD<1)!(LRAN<1)

 ;

 S ORDLOC=$$GET1^DIQ(68.02,LRAN_","_LRAD_","_LRAA,94,"I")

 Q:ORDLOC<1

 ;

 S APCDALVR("APCDTCOL")="`"_ORDLOC

 ;

 S FDA(9009022,BLRLOGDA_",",1106)=ORDLOC

 D UPDATE^DIE("","FDA",,"ERRS")

 Q

 ;

 ;

RDINF63(BLRLOGDA,LRAS,F60IEN,COMPDATE) ; EP - Determine if Result Date is in File 63

 ;      LRAS = Accession

 ;      F60IEN = File 60 IEN

 ;      COMPDATE is date returned, if possible.  Passed by reference.

 ;

 NEW (BLRLOGDA,COMPDATE,DILOCKTM,DISYS,DT,DTIME,DUZ,F60IEN,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,LRAS,U,XPARSYS,XQXFLG)

 ; 

 Q:+$G(F60IEN)<1 0                ; Skip if no File 60 IEN

 Q:$$ISPANEL^BLRPOC(F60IEN) 0     ; Skip if Cosmic Test

 ;

 S LRSB=+$$GET1^DIQ(60,F60IEN,400,"I")

 Q:LRSB<1 0                       ; Skip if no DataName

 ;

 ; Skip if cannot break down Accession Number

 Q:$$GETACCCP^BLRUTIL3(LRAS,.LRAA,.LRAD,.LRAN)<1 0

 ;

 S LRAAIEN=LRAN_","_LRAD_","_LRAA

 S LRDFN=$$GET1^DIQ(68.02,LRAAIEN,.01,"I")

 S LRIDT=$$GET1^DIQ(68.02,LRAAIEN,13.5,"I")

 S LRSS=$$GET1^DIQ(68,LRAA,.02,"I")

 S LRSBSTR=$G(^LR(LRDFN,LRSS,LRIDT,LRSB))

 Q:$L(LRSBSTR)<1 0      ; Skip if no data in Lab Data file

 ;

 S RESULTDT=$P(LRSBSTR,U,6)

 Q:+RESULTDT<1 0     ; Skip if no LEDI IV Result Date

 ;

 S COMPDATE=RESULTDT

 ;

 Q:$$GET1^DIQ(9009022,BLRLOGDA,1309,"I")

 ;

 ; Complete Date not in ^BLRTXLOG, set it

 K FDA,ERRS

 S FDA(9009022,BLRLOGDA_",",1309)=RESULTDT

 D UPDATE^DIE("","FDA",,"ERRS")

 Q 1

BLRLNKU2  ;IHS/OIT/MKK - IHS LABORATORY PCC Utilities 2; 03-Oct-2016 10:42 ; MKK

 +1       ;;5.2;IHS LABORATORY;**1039**;NOV 01, 1997;Build 38

 +2       ;

ADDORDL(BLRLOGDA,APCDALVR) ; EP - Add ORDERING LOCATION to APCDALVR array if missing

 +1        NEW (APCDALVR,BLRLOGDA,DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)

 +2        SET ORDLOC=$$GET1^DIQ(9009022,BLRLOGDA,1106,"I")

 +3        IF ORDLOC

               QUIT 

 +4       ;

 +5        SET LRAS=$$GET1^DIQ(9009022,BLRLOGDA,1202)

 +6        IF $LENGTH(LRAS)<1

               QUIT 

 +7       ;

 +8        IF $$GETACCCP^BLRUTIL3(LRAS,.LRAA,.LRAD,.LRAN)<1

               QUIT 

 +9        IF LRAA<1!(LRAD<1)!(LRAN<1)

               QUIT 

 +10      ;

 +11       SET ORDLOC=$$GET1^DIQ(68.02,LRAN_","_LRAD_","_LRAA,94,"I")

 +12       IF ORDLOC<1

               QUIT 

 +13      ;

 +14       SET APCDALVR("APCDTCOL")="`"_ORDLOC

 +15      ;

 +16       SET FDA(9009022,BLRLOGDA_",",1106)=ORDLOC

 +17       DO UPDATE^DIE("","FDA",,"ERRS")

 +18       QUIT 

 +19      ;

 +20      ;

RDINF63(BLRLOGDA,LRAS,F60IEN,COMPDATE) ; EP - Determine if Result Date is in File 63

 +1       ;      LRAS = Accession

 +2       ;      F60IEN = File 60 IEN

 +3       ;      COMPDATE is date returned, if possible.  Passed by reference.

 +4       ;

 +5        NEW (BLRLOGDA,COMPDATE,DILOCKTM,DISYS,DT,DTIME,DUZ,F60IEN,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,LRAS,U,XPARSYS,XQXFLG)

 +6       ; 

 +7       ; Skip if no File 60 IEN

           IF +$GET(F60IEN)<1

               QUIT 0

 +8       ; Skip if Cosmic Test

           IF $$ISPANEL^BLRPOC(F60IEN)

               QUIT 0

 +9       ;

 +10       SET LRSB=+$$GET1^DIQ(60,F60IEN,400,"I")

 +11      ; Skip if no DataName

           IF LRSB<1

               QUIT 0

 +12      ;

 +13      ; Skip if cannot break down Accession Number

 +14       IF $$GETACCCP^BLRUTIL3(LRAS,.LRAA,.LRAD,.LRAN)<1

               QUIT 0

 +15      ;

 +16       SET LRAAIEN=LRAN_","_LRAD_","_LRAA

 +17       SET LRDFN=$$GET1^DIQ(68.02,LRAAIEN,.01,"I")

 +18       SET LRIDT=$$GET1^DIQ(68.02,LRAAIEN,13.5,"I")

 +19       SET LRSS=$$GET1^DIQ(68,LRAA,.02,"I")

 +20       SET LRSBSTR=$GET(^LR(LRDFN,LRSS,LRIDT,LRSB))

 +21      ; Skip if no data in Lab Data file

           IF $LENGTH(LRSBSTR)<1

               QUIT 0

 +22      ;

 +23       SET RESULTDT=$PIECE(LRSBSTR,U,6)

 +24      ; Skip if no LEDI IV Result Date

           IF +RESULTDT<1

               QUIT 0

 +25      ;

 +26       SET COMPDATE=RESULTDT

 +27      ;

 +28       IF $$GET1^DIQ(9009022,BLRLOGDA,1309,"I")

               QUIT 

 +29      ;

 +30      ; Complete Date not in ^BLRTXLOG, set it

 +31       KILL FDA,ERRS

 +32       SET FDA(9009022,BLRLOGDA_",",1309)=RESULTDT

 +33       DO UPDATE^DIE("","FDA",,"ERRS")

 +34       QUIT 1