Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRVER3

LRVER3.m

Go to the documentation of this file.
  1. LRVER3 ;DALOI/STAFF - DATA VERIFICATION ;05/10/11 13:50
  1. ;;5.2;LAB SERVICE;**42,100,121,140,171,153,221,286,291,406,350,461,499**;Sep 27, 1994;Build 2
  1. ;
  1. D V1
  1. I $D(LRLOCKER)#2 L -@(LRLOCKER) K LRLOCKER
  1. Q
  1. ;
  1. ;
  1. V1 ;
  1. ;
  1. I $D(LRLOCKER)#2 L -@(LRLOCKER)
  1. S LRLOCKER="^LR("_LRDFN_","""_LRSS_""","_LRIDT_")"
  1. D LOCK^DILF(LRLOCKER) ; L +@(LRLOCKER):DILOCKTM
  1. I '$T W !," This entry is being edited by someone else." Q
  1. ;
  1. I $D(LRGVP) S X="1-"_LRNTN D RANGE^LRWU2 G L10
  1. S LRALL="",LRALERT=LROUTINE,LRLCT=6
  1. ;
  1. ; List any not performed or merged tests.
  1. S I=0
  1. F S I=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I)) Q:I<1 D
  1. . S LRX=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I,0))
  1. . I $P(LRX,"^",6)'="*Not Performed",$P(LRX,"^",6)'="*Merged" Q
  1. . W !,?3,$P(^LAB(60,I,0),"^"),?25," ",$P(LRX,"^",6)
  1. . S LRLCT=LRLCT+1 D:LRLCT>22 WT^LRVER4
  1. ;
  1. ; No tests to edit
  1. I LRNTN=0 D COM^LRVR4 G EXIT
  1. ;
  1. F I=1:1:LRNTN I $D(LRNAME(I)) D
  1. . S LRALL=LRALL_","_I W !,I," ",LRNAME(I)
  1. . I $D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,$O(LRNAME(I,0)),0))#2 D
  1. . . S LRX=^LRO(68,LRAA,1,LRAD,1,LRAN,4,$O(LRNAME(I,0)),0)
  1. . . S LRAL=$P(LRX,U,2)#50
  1. . . I $P(LRX,U,5) W ?25,$S($P(LRX,U,6)'="":$P(LRX,U,6),1:" verified")
  1. . . I LRAL S LRALERT=$S(LRAL<LRALERT:LRAL,1:LRALERT)
  1. . S LRLCT=LRLCT+1 D:LRLCT>22 WT^LRVER4
  1. ;
  1. I $D(LRALERT),LRALERT<($P(LRPARAM,U,20)+1) D
  1. . W !?15 W:IOST["C-" @LRVIDO
  1. . W "Test ordered "_$P($G(^LAB(62.05,+LRALERT,0)),U)
  1. . W:IOST["C-" @LRVIDOF W !,$C(7)
  1. ;
  1. S X9="" I LRNTN=1 S T1=1 G L10
  1. V9 S LRALL=$P(LRALL,",",2,99)
  1. R !!,"TEST #(s) (or ""ALL""): ",X:DTIME S:'$T X=U S:X["A" X=LRALL
  1. I X["?" W !,"Enter for example 1,2,5-9." G V9
  1. Q:X[U!(X="") D RANGE^LRWU2 G EXIT:X9="" X (X9_"S:'$D(LRNAME(T1)) X=0") G EXIT:X=0
  1. ;
  1. L10 ;
  1. N LRCORECT S LRCORECT=0
  1. S LRNX=0 X (X9_"D EX1^LRVER1")
  1. ;
  1. ; Calculate days back for delta check based on specimen collection date/time.
  1. S LRTM60=$$LRTM60^LRVR(LRCDT)
  1. D V7^LRVER2
  1. ;
  1. S LRCMTDSP=$$CHKCDSP^LRVERA
  1. K LRSA,LRSB,LRORU3
  1. F LRSB=1:0 S LRSB=$O(^LR(LRDFN,LRSS,LRIDT,LRSB)) Q:LRSB<1 D
  1. . S LRSB(LRSB)=^(LRSB),LRSB(LRSB,"P")=$P(LRSB(LRSB),U,3)
  1. . I $D(LRNOVER) S LRNOVER(LRSB)=""
  1. S LREDIT=1
  1. D ^LRVER4
  1. ;
  1. ; If group data review then quit before updating results
  1. I $D(LRGVP) G EXIT
  1. ;
  1. I '$O(LRORD(0)) G EXIT
  1. ;
  1. ; Set reporting site in file #63.
  1. D SETRL^LRVERA(LRDFN,LRSS,LRIDT,DUZ(2))
  1. ;
  1. I '$G(LRCHG),'LRVF D
  1. . N LRNOW S LRNOW=$$NOW^XLFDT
  1. . F LRSB=1:0 S LRSB=$O(LRSB(LRSB)) Q:LRSB<1 I $P(LRSB(LRSB),"^")'="" D
  1. . . S $P(LRSB(LRSB),U,6)=LRNOW
  1. . . S ^LR(LRDFN,LRSS,LRIDT,LRSB)=LRSB(LRSB)
  1. ;
  1. I $G(LRCHG) D CHG K LRCHG,LRUP I $G(LREND) S LREND=0 D ASKXQA,EXIT Q
  1. ;
  1. I $D(LRSA),$D(LRF) D Q
  1. . K LRF
  1. . S X=$P(^LR(LRDFN,LRSS,LRIDT,0),U,9)
  1. . S:$L(X)&($E(X)'["-") $P(^(0),U,9)="-"_X
  1. . D V11,ASKXQA
  1. ;
  1. ;G EXIT:$D(LRGVP),V11:LRVF&$D(LRSA),V1:LRVF&(LRNTN>1),EXIT:LRVF
  1. I $D(LRGVP) D EXIT Q
  1. I LRVF,$D(LRSA) D V11,ASKXQA Q
  1. I LRVF,LRNTN>1 D V1 Q
  1. I LRVF D ASKXQA,EXIT Q
  1. ;
  1. NOVER ;
  1. I $O(LRNOVER(0)) D G EXIT
  1. . N LRI,LRX
  1. . S LRI=1
  1. . F S LRI=+$O(LRNOVER(LRI)) Q:LRI<2 D
  1. . . N LRX,LRERR
  1. . . S LRX="Test Not Reviewed: "_$$GET1^DID(63.04,LRI,"","LABEL","","LRERR")
  1. . . I $G(LRERR("DIERR",1)) W !,"For DATANAME "_LRI_" - "_LRERR("DIERR",1,"TEXT",1) Q
  1. . . W !,LRX
  1. . . I $D(LRSB(LRI))#2 W " = "_$P(LRSB(LRI),U)_" "_$P(LRSB(LRI),U,2)
  1. . W !,$$CJ^XLFSTR("The above test(s) have results already entered,",IOM)
  1. . W !,$$CJ^XLFSTR("but you did not select them for review.",IOM)
  1. . W !,$$CJ^XLFSTR(" Accession NOT approved. ",IOM),$C(7)
  1. . W !,$$CJ^XLFSTR("You must review all results before ANY can be released.",IOM),!!
  1. . W:$E(IOST,1,2)="C-" @LRVIDO
  1. . W $$CJ^XLFSTR("Suggest you select 'ALL' tests for verification/review. ",IOM)
  1. . W:$E(IOST,1,2)="C-" @LRVIDOF W !,$C(7)
  1. I $O(LRNOVER(0)) W !,"Has not been reviewed and have data. Not approved.",! G EXIT
  1. I '$P($G(LRLABKY),U) W !,$C(7),"ENTERED BUT NOT APPROVED",! G EXIT
  1. I '$O(LRSB(0)) W !?5,"Nothing verified ",$C(7),! G EXIT
  1. N CNT S CNT=1
  1. ;
  1. AGAIN ;
  1. R !,"Approve for release by entering your initials: ",LRINI:DTIME
  1. I $E(LRINI)="^"!(LRINI="") W !!?5,$C(7),"Nothing verified!" D READ G EXIT
  1. I LRINI'=LRUSI,$$UP^XLFSTR(LRINI)=$$UP^XLFSTR(LRUSI) S LRINI=LRUSI
  1. I $S($E(LRINI)="?":1,LRINI'=LRUSI&(CNT<2):1,1:0) W !,$C(7),"Please enter your correct initials" S:$E(LRINI)="?" CNT=0 S CNT=CNT+1 G AGAIN
  1. I LRINI'=LRUSI W !!?5,$C(7),"Nothing verified!" D READ G EXIT
  1. D V11
  1. D ASKXQA
  1. Q
  1. ;
  1. ;
  1. V11 ;
  1. I $D(XRTL) D T0^%ZOSV ; START RESPONSE TIME LOGGING
  1. I +LRDPF=2&($G(LRSS)'="BB")&('$$CHKINP^LRBEBA4(LRDFN,LRODT)) D
  1. .D BAWRK^LRBEBA(LRODT,LRSN,1,.LRBEY,.LRTEST)
  1. D VER^LRVER3A
  1. I $P(LRPARAM,U,14),$P($G(^LRO(68,LRAA,0)),U,16) D LOOK^LRCAPV1
  1. N LRX
  1. S LRX=0
  1. F S LRX=$O(^TMP("LR",$J,"TMP",LRX)) Q:LRX<1 S:'$D(^LRO(68,"AC",LRDFN,LRIDT,LRX)) ^(LRX)="" I LRVF S ^(LRX)=""
  1. I $P($G(LRORU3),U,3),$O(LRSB(0)) D LRORU3
  1. I $D(XRT0) S XRTN="V11^LRVER3" D T1^%ZOSV ; STOP RESPONSE TIME LOGGING
  1. S LRVF=1
  1. Q
  1. ;
  1. ;
  1. EXIT Q
  1. ;
  1. ;
  1. READ ;
  1. N X W !!,"Press ENTER or RETURN to continue: " R X:DTIME
  1. Q
  1. ;
  1. ;
  1. CHG ; Check for changes, save results and create audit trail
  1. N LRNOW
  1. S LRUP="",LRNOW=$$NOW^XLFDT
  1. F S LRCHG=$O(LRSB(LRCHG)) Q:LRCHG<1 D
  1. . I '$D(LRSA(LRCHG)) S LRUP=1 Q
  1. . I $P(LRSA(LRCHG),"^")=""!($P(LRSA(LRCHG),"^")="pending") D Q ; Update user/release time/performing lab if results entered.
  1. . . S LRSA(LRCHG,3)=1
  1. . . S LRUP=1
  1. . . S $P(LRSB(LRCHG),U,4)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
  1. . . S $P(LRSB(LRCHG),U,6)=LRNOW
  1. . . S $P(LRSB(LRCHG),U,9)=$S($G(LRDUZ(2)):LRDUZ(2),$G(DUZ(2)):DUZ(2),1:"")
  1. . I $P(LRSA(LRCHG),"^")'=$P(LRSB(LRCHG),"^") S LRUP=1,$P(LRSA(LRCHG,2),"^")=1 ; results changed
  1. . I $P(LRSA(LRCHG),"^",2)'=$P(LRSB(LRCHG),"^",2) S LRUP=1,$P(LRSA(LRCHG,2),"^",2)=1 ; normalcy flag changed
  1. . I $P(LRSA(LRCHG),"^",5)'=$P(LRSB(LRCHG),"^",5) D ; units/normals changed
  1. . . N LRX,LRY
  1. . . S LRX=$$UP^XLFSTR($P(LRSA(LRCHG),"^",5)),LRX=$TR(LRX,"""")
  1. . . S LRY=$$UP^XLFSTR($P(LRSB(LRCHG),"^",5)),LRY=$TR(LRY,"""")
  1. . . I LRX'=LRY S LRUP=1,$P(LRSA(LRCHG,2),"^",5)=1
  1. . I $D(LRSA(LRCHG,2)) D ; Update user/release time/performing lab if results changed.
  1. . . S $P(LRSB(LRCHG),U,4)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
  1. . . S $P(LRSB(LRCHG),U,6)=LRNOW
  1. . . S $P(LRSB(LRCHG),U,9)=$S($G(LRDUZ(2)):LRDUZ(2),$G(DUZ(2)):DUZ(2),1:"")
  1. I 'LRUP S LREND=1 Q
  1. S LREND=0
  1. W !! W:IOST["C-" @LRVIDO W "Approve update of data by entering your initials: " W:IOST["C-" @LRVIDOF
  1. R LRINI:DTIME
  1. I '$T S LREND=1
  1. I 'LREND,LRINI'=LRUSI,$$UP^XLFSTR(LRINI)=$$UP^XLFSTR(LRUSI) S LRINI=LRUSI
  1. I LRINI'=LRUSI S LREND=1
  1. I LREND W !,$C(7),"No updating occurred ",! Q
  1. ;
  1. F LRSB=1:0 S LRSB=$O(LRSB(LRSB)) Q:LRSB<1 D
  1. . K:'$D(^LR(LRDFN,LRSS,LRIDT,LRSB)) LRSA(LRSB)
  1. . I $P(LRSB(LRSB),"^")'="" S ^LR(LRDFN,LRSS,LRIDT,LRSB)=LRSB(LRSB)
  1. . I $D(LRSA(LRSB,1)),$D(LRSA(LRSB,2)) D DIDLE
  1. ;
  1. W !!
  1. Q
  1. ;
  1. ;
  1. DIDLE ;
  1. ; Check if no previous result or pending result - no audit trail needed
  1. I $P(LRSA(LRSB),"^")=""!($P(LRSA(LRSB),"^")="pending") Q
  1. ;
  1. S LRF=1
  1. L +^LR(LRDFN,LRSS,LRIDT):DILOCKTM+999
  1. NOW ;
  1. N LRNOW7
  1. S LRNOW7=$S($G(LRNOW):LRNOW,1:$$NOW^XLFDT)
  1. W !
  1. D ^LRDIDLE0
  1. I 'LROK K LRSA
  1. L -^LR(LRDFN,LRSS,LRIDT)
  1. S LRCORECT=1
  1. Q
  1. ;
  1. ;
  1. RONLT ; (R)esolve (O)rder NLT code from file #68 original ordered test or
  1. ; use default when not specified for file #60 test.
  1. ;
  1. N LR60,LRX,LRY,X
  1. S LR60=+LRTS,LRY=$P(LRSB(LRSB),U,3)
  1. ;
  1. ; Try to determine order NLT from original ordered test
  1. F Q:'LR60 D
  1. . S LRX=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LR60,0)),LR60=+$P(LRX,"^",9)
  1. . I LR60,LR60'=$P(LRX,"^") D
  1. . . S X=$$NLT^LRVER1(LR60)
  1. . . I X'="" S $P(LRY,"!")=X
  1. . I LR60=$P(LRX,"^") S LR60=0
  1. ;
  1. ; Otherwise use default for lab package
  1. I $P(LRY,"!")="" S $P(LRY,"!")=$P($$DEFCODE^LA7VHLU5(LRSS,LRSB,LRY,+LRSPEC),"!")
  1. ;
  1. S $P(LRSB(LRSB),U,3)=LRY
  1. ;
  1. Q
  1. ;
  1. ;
  1. LRORU3 ;
  1. SET ;
  1. N LR64,LR7V,LRDN,LROTA,LRT,LRTPN,LRTPNN,LRTYPE,X
  1. ;
  1. ; Go through LRSB array and sort results by order NLT code
  1. ; and put into ordered test array (LROTA).
  1. S LRDN=0
  1. F S LRDN=$O(LRSB(LRDN)) Q:'LRDN D
  1. . I $P(LRSB(LRDN),"^")="" Q
  1. . S LRTPNN=$P($P(LRSB(LRDN),U,3),"!"),LRT=+$G(^TMP("LR",$J,"TMP",LRDN))
  1. . I LRTPNN="" Q
  1. . S LRTYPE=$P($G(^LAB(60,LRT,0)),U,3)
  1. . I LRTYPE=""!("OB"'[LRTYPE) Q
  1. . S LROTA(LRTPNN,LRDN)=LRT
  1. . I $D(LRSA(LRDN,2)) S LROTA(LRTPNN,LRDN,1)="C"
  1. ;
  1. ; For each order NLT code setup call to put results into #62.49 queue
  1. S LRTPNN=""
  1. F S LRTPNN=$O(LROTA(LRTPNN)) Q:LRTPNN="" D
  1. . S LR64=+$O(^LAM("C",LRTPNN_" ",0)),LRTPN=$$GET1^DIQ(64,LR64_",",.01)
  1. . K LR7V
  1. . M LR7V=LROTA(LRTPNN)
  1. . D SET^LA7VMSG($P(LRORU3,U,4),$P(LRORU3,U,2),$P(LRORU3,U,5),$P(LRORU3,U,3),LRTPN,LRTPNN,LRIDT,LRSS,LRDFN,LRODT,.LR7V,"ORU")
  1. Q
  1. ;
  1. ;
  1. ASKXQA ; Determine if user should be asked to send CPRS Alert
  1. ;
  1. N LRDEFAULT
  1. ;
  1. ; No CPRS alert for non-PATIENT file (#2) patients
  1. I +LRDPF'=2 Q
  1. ;
  1. S LRDEFAULT=$$GET^XPAR("USR^DIV^PKG","LR CH VERIFY CPRS ALERT",1,"Q")
  1. I LRDEFAULT>0 D ASKXQA^LR7ORB3(LRDFN,"CH",LRIDT,LRUID,LRDEFAULT)
  1. ;
  1. Q