BLRAGUT3 ; IHS/MSC/SAT - LABORATORY ACCESSION GUI RPC UTILITIES 3; 27-Jun-2016 08:52 ; MKK
;;5.2;IHS LABORATORY;**1039**;NOV 01, 1997;Build 38
;
RLALLTST(ORDERN) ; EP - Reference Lab ALL TeSTs
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,ORDERN,U,XPARSYS,XQXFLG)
;
S BLRDT=0
F S BLRDT=$O(^LRO(69,"C",ORDERN,BLRDT)) Q:BLRDT<1 D
. S BLRSP=0
. F S BLRSP=$O(^LRO(69,"C",ORDERN,BLRDT,BLRSP)) Q:BLRSP<1 D
.. S BLRTSN=0
.. F S BLRTSN=$O(^LRO(69,BLRDT,1,BLRSP,2,"B",BLRTSN)) Q:BLRTSN<1 D
... D REFLABS
Q
;
;
REFLABS ; EP - Store Info into 9009026.3
Q:+$P($G(^BLRSITE(DUZ(2),"RL")),U)<1 ; If not Ref Lab, don't store
;
; --- DEBUG START
D
. NEW TMPBLRRF
. ; M TMPBLRRF=^TMP("BLRRL",$J)
. ; D FORCEIT^BLRUTIL7("REFLABS^BLRAGUT3 0.0")
; --- DEBUG END
;
NEW AGINS,BDA,BDAC,BLRSEQ,DFN,ERRS,FDA,INSS,LRDFN,LROIEN,ORDIEN,PLCYHLDR,POLICYN,REFLORDN
;
S LROIEN=BLRSP_","_BLRDT
S REFLORDN=+$$GET1^DIQ(69.01,LROIEN,9.5,"I")
Q:REFLORDN<1
;
S LRDFN=$$GET1^DIQ(69.01,LROIEN,.01,"I")
S DFN=$$GET1^DIQ(63,LRDFN,.03,"I")
;
S X=$$ORD^BLRRLEDI(REFLORDN,DFN) ; Create entry in 9009026.3, if necessary
S ORDIEN=$$FIND1^DIC(9009026.3,,,REFLORDN)
Q:ORDIEN<1 ; Quit if Order # NOT in 9009026.3
;
S PLCYHLDR=+$O(^AUPN3PPH("C",DFN,"A"),-1) ; PoLiCY HoLDeR
S POLICYN=$$GET1^DIQ(9000003.1,PLCYHLDR,.04,"I") ; POLICY Number
;
I $L($G(BLRRL("CLIENT"))) S FDA(9009026.3,ORDIEN_",",.03)=$G(BLRRL("CLIENT"))
E S:POLICYN FDA(9009026.3,ORDIEN_",",.03)=POLICYN
S FDA(9009026.3,ORDIEN_",",.05)=BLRBT
;
D UPDATE^DIE(,"FDA",,"ERRS")
;
D STUFFINS(DFN,REFLORDN)
; D FORCEIT^BLRUTIL7("REFLABS^BLRAGUT 9.0","BLRRL")
; D SETINS^BLRAG05C
Q
;
STUFFINS(DFN,OR) ; "Stuff Insurance" -- OR = Order Number
; NEW (BLRDT,BLRSP,DILOCKTM,DISYS,DFN,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,OR,PAT,U,XPARSYS,XQXFLG)
S BDAC=0
D ^AGINS
Q:'$D(AGINS(1)) ; Patient has No Insurance on file
;
D SEQINS^BLRRLEDI(.AGINS,DFN,DT)
S BDA=0 F S BDA=$O(BLRSEQ(BDA)) Q:'BDA!(BDAC>3) D
. S BDAC=BDAC+1
. S INSS=$TR($G(BLRSEQ(BDA)),"^","~") ;have to switch to ~ for filing
. D UPINS^BLRRLEDI(OR,"",DFN,INSS)
Q
BLRAGUT3 ; IHS/MSC/SAT - LABORATORY ACCESSION GUI RPC UTILITIES 3; 27-Jun-2016 08:52 ; MKK
+1 ;;5.2;IHS LABORATORY;**1039**;NOV 01, 1997;Build 38
+2 ;
RLALLTST(ORDERN) ; EP - Reference Lab ALL TeSTs
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,ORDERN,U,XPARSYS,XQXFLG)
+2 ;
+3 SET BLRDT=0
+4 FOR
SET BLRDT=$ORDER(^LRO(69,"C",ORDERN,BLRDT))
IF BLRDT<1
QUIT
Begin DoDot:1
+5 SET BLRSP=0
+6 FOR
SET BLRSP=$ORDER(^LRO(69,"C",ORDERN,BLRDT,BLRSP))
IF BLRSP<1
QUIT
Begin DoDot:2
+7 SET BLRTSN=0
+8 FOR
SET BLRTSN=$ORDER(^LRO(69,BLRDT,1,BLRSP,2,"B",BLRTSN))
IF BLRTSN<1
QUIT
Begin DoDot:3
+9 DO REFLABS
End DoDot:3
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
+12 ;
REFLABS ; EP - Store Info into 9009026.3
+1 ; If not Ref Lab, don't store
IF +$PIECE($GET(^BLRSITE(DUZ(2),"RL")),U)<1
QUIT
+2 ;
+3 ; --- DEBUG START
+4 Begin DoDot:1
+5 NEW TMPBLRRF
+6 ; M TMPBLRRF=^TMP("BLRRL",$J)
+7 ; D FORCEIT^BLRUTIL7("REFLABS^BLRAGUT3 0.0")
End DoDot:1
+8 ; --- DEBUG END
+9 ;
+10 NEW AGINS,BDA,BDAC,BLRSEQ,DFN,ERRS,FDA,INSS,LRDFN,LROIEN,ORDIEN,PLCYHLDR,POLICYN,REFLORDN
+11 ;
+12 SET LROIEN=BLRSP_","_BLRDT
+13 SET REFLORDN=+$$GET1^DIQ(69.01,LROIEN,9.5,"I")
+14 IF REFLORDN<1
QUIT
+15 ;
+16 SET LRDFN=$$GET1^DIQ(69.01,LROIEN,.01,"I")
+17 SET DFN=$$GET1^DIQ(63,LRDFN,.03,"I")
+18 ;
+19 ; Create entry in 9009026.3, if necessary
SET X=$$ORD^BLRRLEDI(REFLORDN,DFN)
+20 SET ORDIEN=$$FIND1^DIC(9009026.3,,,REFLORDN)
+21 ; Quit if Order # NOT in 9009026.3
IF ORDIEN<1
QUIT
+22 ;
+23 ; PoLiCY HoLDeR
SET PLCYHLDR=+$ORDER(^AUPN3PPH("C",DFN,"A"),-1)
+24 ; POLICY Number
SET POLICYN=$$GET1^DIQ(9000003.1,PLCYHLDR,.04,"I")
+25 ;
+26 IF $LENGTH($GET(BLRRL("CLIENT")))
SET FDA(9009026.3,ORDIEN_",",.03)=$GET(BLRRL("CLIENT"))
+27 IF '$TEST
IF POLICYN
SET FDA(9009026.3,ORDIEN_",",.03)=POLICYN
+28 SET FDA(9009026.3,ORDIEN_",",.05)=BLRBT
+29 ;
+30 DO UPDATE^DIE(,"FDA",,"ERRS")
+31 ;
+32 DO STUFFINS(DFN,REFLORDN)
+33 ; D FORCEIT^BLRUTIL7("REFLABS^BLRAGUT 9.0","BLRRL")
+34 ; D SETINS^BLRAG05C
+35 QUIT
+36 ;
STUFFINS(DFN,OR) ; "Stuff Insurance" -- OR = Order Number
+1 ; NEW (BLRDT,BLRSP,DILOCKTM,DISYS,DFN,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,OR,PAT,U,XPARSYS,XQXFLG)
+2 SET BDAC=0
+3 DO ^AGINS
+4 ; Patient has No Insurance on file
IF '$DATA(AGINS(1))
QUIT
+5 ;
+6 DO SEQINS^BLRRLEDI(.AGINS,DFN,DT)
+7 SET BDA=0
FOR
SET BDA=$ORDER(BLRSEQ(BDA))
IF 'BDA!(BDAC>3)
QUIT
Begin DoDot:1
+8 SET BDAC=BDAC+1
+9 ;have to switch to ~ for filing
SET INSS=$TRANSLATE($GET(BLRSEQ(BDA)),"^","~")
+10 DO UPINS^BLRRLEDI(OR,"",DFN,INSS)
End DoDot:1
+11 QUIT
