BLRRLV ; cmi/anch/maw - BLR Verify Reference Lab Results ;
;;5.2;LR;**1021**;Jul 27, 2006
;;1.0;BLR REFERENCE LAB;;MAR 14, 2005
;
;
;
;this routine will allow the user to verify reference lab results
;before passing them on to PCC
;
MAIN ;EP - this is the main routine driver
S BLRVER=$$ASKV
I $G(BLRVER) D RFL,EOJ Q
D LOOP
D EOJ
Q
;
ASKV() ;-- ask to mark all as verified
S DIR(0)="Y",DIR("A")="Do you wish to mark all results as verified"
S DIR("B")="N"
D ^DIR
K DIR
Q +$G(Y)
;
LOOP ;-- loop the xref and call VER
I '$O(^BLRTXLOG("BVER",0)) D Q
. W !,"No results to verify"
S DIC="^BLRTXLOG("
S BLRVDA=0 F S BLRVDA=$O(^BLRTXLOG("BVER",BLRVDA)) Q:'BLRVDA!$G(BLRVQ) D
. Q:$G(BLRVQ)
. W @IOF
. S DA=BLRVDA
. D DIQ^BLRLM(DIC,DA)
I '$O(^BLRTXLOG("BVER",0)) D Q
. W !!,"No more results to verify"
I $O(^BLRTXLOG("BVER",0)) D Q
. W !!,"Please come back and verify remaining results"
Q
;
UPD(DA) ;-- mark entry as verified
S DIE="^BLRTXLOG("
S DR="2006////"_$G(DUZ)_";2007///"_$$GET1^DIQ(200,DUZ,.01,"E")
D ^DIE
K ^BLRTXLOG("BVER",BLRVDA)
D ^BLREVTQ("M","REFILE","REFILE",,BLRVDA)
Q
;
RMV(DA) ;-- remove the entry from the tx log
S DIK="^BLRTXLOG(" D ^DIK
K ^BLRTXLOG("BVER",DA)
Q
;
RFL ;-- mark all as verified and refile
W !,"Now marking all results as verified"
S BLRVDA=0 F S BLRVDA=$O(^BLRTXLOG("BVER",BLRVDA)) Q:'BLRVDA D
. W "."
. S DA=BLRVDA
. S DIE="^BLRTXLOG("
. S DR="2006////"_$G(DUZ)_";2007///"_$$GET1^DIQ(200,DUZ,.01,"E")
. D ^DIE
. K ^BLRTXLOG("BVER",BLRVDA)
. D ^BLREVTQ("M","REFILE","REFILE",,BLRVDA)
Q
;
VER() ; EP -- verify individual results
S DIR(0)="Y",DIR("A")="Mark this result as verified"
D ^DIR
K DIR
Q +$G(Y)
;
XREF(XIEN) ; EP -- setup the x ref for Source Of Data Input
S BLRRL=$P($G(^BLRSITE(DUZ(2),"RL")),U)
Q:'BLRRL
S BLRHLD=$P($G(^BLRRL(BLRRL,0)),U,11)
Q:'BLRHLD
S BLRUNI=$P($G(^BLRRL(BLRRL,0)),U,10)
Q:'BLRUNI
S ^BLRTXLOG("BVER",DA)="R"
Q
;
EOJ ;-- kill variables
D JOB^BLRPARAM
D EN^XBVK("BLR")
Q
;
BLRRLV ; cmi/anch/maw - BLR Verify Reference Lab Results ;
+1 ;;5.2;LR;**1021**;Jul 27, 2006
+2 ;;1.0;BLR REFERENCE LAB;;MAR 14, 2005
+3 ;
+4 ;
+5 ;
+6 ;this routine will allow the user to verify reference lab results
+7 ;before passing them on to PCC
+8 ;
MAIN ;EP - this is the main routine driver
+1 SET BLRVER=$$ASKV
+2 IF $GET(BLRVER)
DO RFL
DO EOJ
QUIT
+3 DO LOOP
+4 DO EOJ
+5 QUIT
+6 ;
ASKV() ;-- ask to mark all as verified
+1 SET DIR(0)="Y"
SET DIR("A")="Do you wish to mark all results as verified"
+2 SET DIR("B")="N"
+3 DO ^DIR
+4 KILL DIR
+5 QUIT +$GET(Y)
+6 ;
LOOP ;-- loop the xref and call VER
+1 IF '$ORDER(^BLRTXLOG("BVER",0))
Begin DoDot:1
+2 WRITE !,"No results to verify"
End DoDot:1
QUIT
+3 SET DIC="^BLRTXLOG("
+4 SET BLRVDA=0
FOR
SET BLRVDA=$ORDER(^BLRTXLOG("BVER",BLRVDA))
IF 'BLRVDA!$GET(BLRVQ)
QUIT
Begin DoDot:1
+5 IF $GET(BLRVQ)
QUIT
+6 WRITE @IOF
+7 SET DA=BLRVDA
+8 DO DIQ^BLRLM(DIC,DA)
End DoDot:1
+9 IF '$ORDER(^BLRTXLOG("BVER",0))
Begin DoDot:1
+10 WRITE !!,"No more results to verify"
End DoDot:1
QUIT
+11 IF $ORDER(^BLRTXLOG("BVER",0))
Begin DoDot:1
+12 WRITE !!,"Please come back and verify remaining results"
End DoDot:1
QUIT
+13 QUIT
+14 ;
UPD(DA) ;-- mark entry as verified
+1 SET DIE="^BLRTXLOG("
+2 SET DR="2006////"_$GET(DUZ)_";2007///"_$$GET1^DIQ(200,DUZ,.01,"E")
+3 DO ^DIE
+4 KILL ^BLRTXLOG("BVER",BLRVDA)
+5 DO ^BLREVTQ("M","REFILE","REFILE",,BLRVDA)
+6 QUIT
+7 ;
RMV(DA) ;-- remove the entry from the tx log
+1 SET DIK="^BLRTXLOG("
DO ^DIK
+2 KILL ^BLRTXLOG("BVER",DA)
+3 QUIT
+4 ;
RFL ;-- mark all as verified and refile
+1 WRITE !,"Now marking all results as verified"
+2 SET BLRVDA=0
FOR
SET BLRVDA=$ORDER(^BLRTXLOG("BVER",BLRVDA))
IF 'BLRVDA
QUIT
Begin DoDot:1
+3 WRITE "."
+4 SET DA=BLRVDA
+5 SET DIE="^BLRTXLOG("
+6 SET DR="2006////"_$GET(DUZ)_";2007///"_$$GET1^DIQ(200,DUZ,.01,"E")
+7 DO ^DIE
+8 KILL ^BLRTXLOG("BVER",BLRVDA)
+9 DO ^BLREVTQ("M","REFILE","REFILE",,BLRVDA)
End DoDot:1
+10 QUIT
+11 ;
VER() ; EP -- verify individual results
+1 SET DIR(0)="Y"
SET DIR("A")="Mark this result as verified"
+2 DO ^DIR
+3 KILL DIR
+4 QUIT +$GET(Y)
+5 ;
XREF(XIEN) ; EP -- setup the x ref for Source Of Data Input
+1 SET BLRRL=$PIECE($GET(^BLRSITE(DUZ(2),"RL")),U)
+2 IF 'BLRRL
QUIT
+3 SET BLRHLD=$PIECE($GET(^BLRRL(BLRRL,0)),U,11)
+4 IF 'BLRHLD
QUIT
+5 SET BLRUNI=$PIECE($GET(^BLRRL(BLRRL,0)),U,10)
+6 IF 'BLRUNI
QUIT
+7 SET ^BLRTXLOG("BVER",DA)="R"
+8 QUIT
+9 ;
EOJ ;-- kill variables
+1 DO JOB^BLRPARAM
+2 DO EN^XBVK("BLR")
+3 QUIT
+4 ;
