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

LRVER4.m

Go to the documentation of this file.
  1. LRVER4 ;DALOI/STAFF - LAB ROUTINE DATA VERIFICATION ;07/06/10 14:08
  1. ;;5.2;LAB SERVICE;**14,42,112,121,140,171,153,188,279,283,286,350,437,488**;Sep 27, 1994;Build 1
  1. ;
  1. N LRAMEND,LRRFLAG
  1. ;
  1. LOOP ;
  1. S LRLCT=0
  1. I '$D(LRGVP) D
  1. . S:$D(LRWRDS) LRWRD=LRWRDS
  1. . W !!,PNM," SSN: ",SSN," " S LRLCT=LRLCT+1
  1. . I LRDPF=2 W " LOC: ",$S(LRWRD'="":LRWRD,1:$S($L($P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,7)):$P(^(0),U,7),1:"??"))
  1. ;
  1. W !,"Pat Info: ",$P($G(^LR(LRDFN,.091)),U)
  1. W ?34," Sex: ",$S(SEX="M":"MALE",SEX="F":"FEMALE",1:SEX)
  1. W ?48," Age: ",$$CALCAGE^LRRPU(DOB,LRCDT)," as of ",$$FMTE^XLFDT(LRCDT,"1D")
  1. S LRPRAC=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,8)
  1. I LRPRAC>0,LRPRAC=+LRPRAC D GETS^DIQ(200,LRPRAC_",",".01;.132;.137;.138","E","LRPRAC(LRPRAC)","LRERR")
  1. W !,"Provider: "
  1. S LRLCT=LRLCT+2
  1. I LRPRAC'="",'$D(LRPRAC(LRPRAC,200)) W LRPRAC
  1. I LRPRAC,$D(LRPRAC(LRPRAC,200)) D
  1. . W LRPRAC(LRPRAC,200,LRPRAC_",",.01,"E"),?40," Voice pager: ",LRPRAC(LRPRAC,200,LRPRAC_",",.137,"E")
  1. . W !," Phone: ",LRPRAC(LRPRAC,200,LRPRAC_",",.132,"E"),?38," Digital pager: ",LRPRAC(LRPRAC,200,LRPRAC_",",.138,"E")
  1. . S LRLCT=LRLCT+1
  1. ;
  1. N PRAC,PR
  1. D PRAC^LR7OMERG(LRAA,LRAD,LRAN,.PRAC)
  1. I $O(PRAC(0)) D
  1. . S PR=0
  1. . F S PR=$O(PRAC(PR)) Q:PR<1 I $D(^VA(200,PR,0)) W !?14,$P(^(0),"^") S LRLCT=LRLCT+1
  1. W ! S LRLCT=LRLCT+1
  1. S LRNX=0,LRVRM=2,T=""
  1. I $P(^LR(LRDFN,LRSS,LRIDT,0),U,7)'="" D
  1. . W !,"VOLUME: ",$P(^(0),U,7)
  1. . S LRLCT=LRLCT+1
  1. S LRACC=$P(Z1,U,6)
  1. W !,"ACCESSION:",?30,$P(Z2,U,6),?44," ",LRACC_" ["_LRUID,"]"
  1. W !,?30,LRDAT(2) W ?44," ",LRDAT
  1. S LRLCT=LRLCT+2
  1. I $D(LRALERT),LRALERT<($P(LRPARAM,U,20)+1) D
  1. . W !?15 W:$E(IOST,1,2)="C-" @LRVIDO
  1. . W "Test ordered "_$P($G(^LAB(62.05,+LRALERT,0)),U)
  1. . W:$E(IOST,1,2)="C-" @LRVIDOF,$C(7)
  1. . S LRLCT=LRLCT+1
  1. ;
  1. I '$O(LRORD(0)) W !!?7,$C(7),"This is not a verifiable test/accession ",! Q
  1. V I $D(LRGVP) D V20 Q
  1. G EDIT:($O(^LR(LRDFN,LRSS,LRIDT,1))=""!('LRVF&$D(LRPER)))&'$D(LRNUF)
  1. K LRNUF
  1. D V20,ND G V37:LRVF&'$D(X)#2,EDIT:LREDIT
  1. S LRTEC=$S($D(^LRO(68,LRAA,1,LRAD,2)):$P(^(2),U),1:$S($D(LRUSI):LRUSI,1:"")),LREDIT=0
  1. V36 ;
  1. Q:$D(LRGVP)
  1. K DIR
  1. S DIR(0)="SAO^E:Edit;C:Comments;W:Workload"
  1. S DIR("A")="SELECT ('E' to Edit, 'C' for Comments, 'W' Workload): "
  1. D ^DIR
  1. I $D(DIRUT) S X="^" G V37
  1. S X=Y
  1. S:$E(X)="E" LREDIT=1,X=""
  1. K LRNC
  1. I $E(X)="C" S LRNC=1 D COM K LRNC G V36
  1. I $E(X)="W" D G LOOP
  1. . I $P(LRPARAM,U,14),$P($G(^LRO(68,LRAA,0)),U,16) D STD^LRCAPV,EN^LRCAPV S LREND=0 Q
  1. . W !?10," Workload is not activated."
  1. S X=$S(X="@":"",X="":LRTEC,1:X),LRTEC=X
  1. S:'$D(^LRO(68,LRAA,1,LRAD,2)) ^(2)="" S ^(2)=X_U_$P(^(2),U,2,99)
  1. G EDIT:LREDIT
  1. V37 Q ;LEAVE LRVER4, BACK TO LRVER3
  1. ;
  1. ;
  1. V20 ;
  1. I $G(LRCHG) D V21,LRCFL,DCOM^LRVERA Q
  1. S LRNX=$O(LRORD(LRNX)) G V35:LRNX<1 D SUBS
  1. G:'$G(LRTS) V20
  1. I '$D(LRSB(LRSB)),'$D(^LR(LRDFN,LRSS,LRIDT,LRSB)) G V20
  1. D V25^LRVER5
  1. ;
  1. D:$D(LRGVP) PG Q:$D(LRGVP)&($D(DTOUT)!$D(DUOUT))
  1. ;
  1. W !,$P(^LAB(60,+LRTS,0),U)
  1. S X1=""
  1. I $D(^LR(LRDFN,LRSS,+LRLDT,LRSB)) D
  1. . S X1=$P(^(LRSB),U),X=X1
  1. . I $$GET1^DID(63.04,LRSB,"","TYPE","","LRERR")="SET" D
  1. . . S X=$$EXTERNAL^DILFD(63.04,LRSB,"",X1)
  1. . . I X="" S X=X1
  1. . W:X'="" ?30,@LRFP
  1. S (X,LRFLG)=""
  1. I $D(LRSB(LRSB)) D
  1. . N LRX
  1. . K LRNOVER(LRSB)
  1. . S (LRDL,LRX,X)=$P(LRSB(LRSB),U)
  1. . S LREDIT=0,LRFLG=$P(LRSB(LRSB),U,2)
  1. . I $$GET1^DID(63.04,LRSB,"","TYPE","","LRERR")="SET" D
  1. . . S X=$$EXTERNAL^DILFD(63.04,LRSB,"",LRX)
  1. . . I X="" S X=LRX
  1. . W ?44," ",@LRFP," ",LRFLG,?56," ",$P($P(LRSB(LRSB),U,5),"!",7) ;$P(LRNG,U,7)
  1. . S X=LRX
  1. . I X=""!(X="canc")!(X="comment")!(X="pending") Q
  1. . S Y=0
  1. . I LRDEL'="" S LRQ=1 D XDELTACK^LRVERA K LRQ
  1. . W " "
  1. . I '$D(LRQ),$E(LRFLG,2)="*" D DISPFLG^LRVER4
  1. ;
  1. S:$P(X,U)="" $P(LRSB(LRSB),U)=""
  1. I $P(X,U)'="" D
  1. . N I,LRX,LRY
  1. . S $P(LRSB(LRSB),U)=X,$P(LRSB(LRSB),U,2)=LRFLG
  1. . S LRX=$$TMPSB^LRVER1(LRSB),LRY=$P(LRSB(LRSB),U,3)
  1. . F I=1:1:$L(LRX,"!") I $P(LRY,"!",I)="" S $P(LRY,"!",I)=$P(LRX,"!",I)
  1. . S $P(LRSB(LRSB),U,3)=LRY
  1. . I $P($P(LRSB(LRSB),U,3),"!")="" D RONLT^LRVER3
  1. . D
  1. . . I $P(LRSB(LRSB),U,4)!($P(LRSB(LRSB),U)="pending") Q
  1. . . I '$D(LRSA(LRSB))#2 S $P(LRSB(LRSB),U,4)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ)),$P(LRSB(LRSB),U,9)=$S($G(LRDUZ(2)):LRDUZ(2),$G(DUZ(2)):DUZ(2),1:"") Q
  1. . . I $P(LRSB(LRSB),U)=$P(LRSA(LRSB),U) S:$P(LRSA(LRSB),U,4) $P(LRSB(LRSB),U,4)=$P(LRSA(LRSB),U,4) S $P(LRSA(LRSB),U,3)=$P(LRSB(LRSB),U,3) Q
  1. . . S:'$P(LRSB(LRSB),U,4) $P(LRSB(LRSB),U,4)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ)),$P(LRSB(LRSB),U,9)=$S($G(LRDUZ(2)):LRDUZ(2),$G(DUZ(2)):DUZ(2),1:"")
  1. . I $P(LRSB(LRSB),U,5)="" S $P(LRSB(LRSB),U,5)=$TR(LRNGS,U,"!")
  1. I '$D(LRNUF) S LRLCT=LRLCT+1 S:$X>80 LRLCT=LRLCT+1 D:LRLCT>22 WT G:$G(Y)'="^" V20
  1. ;
  1. V35 ;
  1. D LRCFL:LRCFL]""
  1. D DCOM^LRVERA K LRNUF
  1. Q
  1. ;
  1. ;
  1. LRCFL ;
  1. S LREXEC=LRCFL D ^LREXEC:LRCFL[""
  1. D:LRLCT>22 WT
  1. Q
  1. ;
  1. ;
  1. EDIT ;
  1. K LROUT
  1. D ^LRVER5 S LRVRM=2 G:$G(LRCHG) LOOP G LRCFL:$D(LROUT)!$D(LRPER)
  1. G LOOP
  1. ;
  1. ;
  1. RANGE ;
  1. N LRI,LRFIND
  1. S Y=X
  1. I X=""!(X="canc")!(X="comment")!(X="pending") Q
  1. W " "
  1. F LRI=1:1:$L(X) S LRFIND=$E(X,LRI) Q:LRFIND?1(1N,1A,1".",1"-",1"<",1">")
  1. S X=$E(X,LRI,999)
  1. ;
  1. ; User has indicated specific normality to set - used when entering
  1. ; reference lab results and all the info to calculate is not available.
  1. I $G(LRRFLAG(LRSB)) S LRFLG=$P("L^L*^H^H*","^",LRRFLAG(LRSB))
  1. ;
  1. E D RANGECHK
  1. I '$D(LRQ),$E(LRFLG,2)="*" D DISPFLG^LRVER4
  1. RQ S X=Y
  1. Q
  1. ;
  1. ;
  1. RANGECHK ; Check result against reference ranges and set flag
  1. ;
  1. ;
  1. ; Check for numeric abnormal results
  1. I X?.1"-".N.1".".N D Q
  1. . I LRNG4'="",LRNG4?.1"-".N.1".".N,X<LRNG4 S LRFLG="L*" Q
  1. . I LRNG5'="",LRNG5?.1"-".N.1".".N,X>LRNG5 S LRFLG="H*" Q
  1. . I LRNG2'="",LRNG2?.1"-".N.1".".N,X<LRNG2 S LRFLG="L" Q
  1. . I LRNG3'="",LRNG3?.1"-".N.1".".N,X>LRNG3 S LRFLG="H" Q
  1. ;
  1. ; Check for <> abnormal results
  1. ; "<" results checked against low values
  1. ; ">" results checked against high values
  1. I X?1(1"<",1">").N.1".".N D Q
  1. . N LRX
  1. . S LRX=$E(X,2,$L(X))
  1. . I $E(X)="<" D Q
  1. . . I LRNG4'="",LRNG4?.N.1".".N,LRX<LRNG4 S LRFLG="L*" Q
  1. . . I LRNG4'="",LRNG4?.N.1".".N,LRX=LRNG4 S LRFLG="L*" Q
  1. . . I LRNG2'="",LRNG2?.N.1".".N,LRX<LRNG2 S LRFLG="L" Q
  1. . . I LRNG2'="",LRNG2?.N.1".".N,LRX=LRNG2 S LRFLG="L" Q
  1. . I $E(X)=">" D Q
  1. . . I LRNG5'="",LRNG5?.N.1".".N,LRX>LRNG5 S LRFLG="H*" Q
  1. . . I LRNG5'="",LRNG5?.N.1".".N,LRX=LRNG5 S LRFLG="H*" Q
  1. . . I LRNG3'="",LRNG3?.N.1".".N,LRX>LRNG3 S LRFLG="H" Q
  1. . . I LRNG3'="",LRNG3?.N.1".".N,LRX=LRNG3 S LRFLG="H" Q
  1. ;
  1. ; Check for ranges, i.e. 0-5, 6-10.
  1. ; Compare first value to abnormal value
  1. I X?1.N1"-"1.N D Q
  1. . I LRNG4'="",LRNG4?.N.1".".N,+X<LRNG4 S LRFLG="L*" Q
  1. . I LRNG5'="",LRNG5?.N.1".".N,+X>LRNG5 S LRFLG="H*" Q
  1. . I LRNG2'="",LRNG2?.N.1".".N,+X<LRNG2 S LRFLG="L" Q
  1. . I LRNG3'="",LRNG3?.N.1".".N,+X>LRNG3 S LRFLG="H" Q
  1. ;
  1. Q
  1. ;
  1. ;
  1. DISPFLG ; Display critical flags
  1. ;
  1. I $E(IOST,1,2)="C-" W $C(7),@LRVIDO
  1. W "CRITICAL ",$S($E(LRFLG,1)="L":"LOW",$E(LRFLG,1)="H":"HIGH",1:""),"!!"
  1. I $E(IOST,1,2)="C-" W @LRVIDOF,$C(7),$C(7)
  1. Q
  1. ;
  1. ;
  1. SUBS ;
  1. S LRSB=LRORD(LRNX),LRTS=$S($D(^TMP("LR",$J,"TMP",LRSB)):^(LRSB),1:0)
  1. Q
  1. ;
  1. ;
  1. ND ;
  1. K X,DIR
  1. Q:'LRVF
  1. I '$P($G(LRLABKY),U) D Q
  1. . W !,"You're not authorized to edit verified data."
  1. . S LREDIT=0
  1. S DIR(0)="FO"
  1. S DIR("A")="If you need to change something, enter your initials"
  1. S DIR("?")="To change verified results, enter your initials."
  1. D ^DIR
  1. S X=Y K DIR
  1. I $$UP^XLFSTR(X)'=$$UP^XLFSTR(LRUSI) S LREDIT=0 K X QUIT
  1. I $D(X)#2,'$G(LRCHG) W ! D S LRCHG=1
  1. . K LRSA S LRSA=1
  1. . F S LRSA=$O(^LR(LRDFN,"CH",LRIDT,LRSA)) Q:'LRSA S LRSA(LRSA)=^(LRSA)
  1. Q
  1. ;
  1. ;
  1. WT S LRLCT=0 Q:$D(LRGVP)
  1. W !,"PRESS ANY KEY TO CONTINUE, '^' TO STOP " R Y:DTIME S:'$T Y="^"
  1. Q
  1. ;
  1. ;
  1. COM ;from LRVER5
  1. Q:$D(LRGVP)
  1. K DR
  1. S DIE="^LR("_LRDFN_",""CH"",",DA=LRIDT,DA(1)=LRDFN,DR=.99
  1. D ^DIE,COM1:$D(LRNC)
  1. L +^LR(LRDFN,LRSS,LRIDT):5
  1. I $O(^LR(LRDFN,"CH",LRIDT,1,0))="" K ^LR(LRDFN,"CH",LRIDT,1)
  1. L -^LR(LRDFN,LRSS,LRIDT)
  1. Q
  1. ;
  1. ;
  1. VOL ;
  1. W !,"VOLUME: ",$P(^LR(LRDFN,LRSS,LRIDT,0),U,7),"//" R X:DTIME
  1. G VOL:X["?" S:X'=""&(X'[U) ^(0)=$P(^(0),U,1,6)_U_X_U_$P(^(0),U,8,10)
  1. G COM
  1. ;
  1. ;
  1. COM1 ;
  1. N LRX Q:'$P(^LR(LRDFN,LRSS,LRIDT,0),U,3)
  1. D XREF^LRVER3A
  1. S LRX=0 F S LRX=$O(^TMP("LR",$J,"TMP",LRX)) Q:LRX<1 S ^LRO(68,"AC",LRDFN,LRIDT,LRX)=""
  1. I $L($P(^LR(LRDFN,LRSS,LRIDT,0),U,9)),$E($P(^(0),U,9))'="-" S $P(^(0),U,9)="-"_$P(^(0),U,9)
  1. Q
  1. ;
  1. ;
  1. PG Q:$Y<(IOSL+5)
  1. I $E(IOST,1,2)'="C-" W @IOF Q
  1. D PG^LRGVP
  1. Q
  1. ;
  1. V21 ;
  1. N Y,LREND
  1. S LRSB=1,LRLCT=1
  1. F S LRSB=+$O(LRSB(LRSB)) Q:'LRSB!($G(LREND)) D
  1. . N LRX
  1. . S LRTS=$O(^LAB(60,"C","CH;"_LRSB_";1",0)) Q:'LRTS
  1. . D V25^LRVER5
  1. . W !,$P(^LAB(60,LRTS,0),U) S X1=""
  1. . I $D(^LR(LRDFN,LRSS,+LRLDT,LRSB)) D
  1. . . S X1=$P(^(LRSB),U),(LRDL,X)=X1
  1. . . I $$GET1^DID(63.04,LRSB,"","TYPE","","LRERR")="SET" D
  1. . . . S X=$$EXTERNAL^DILFD(63.04,LRSB,"",X1)
  1. . . . I X="" S X=X1
  1. . . W:X'="" ?30,@LRFP
  1. . S (LRDL,LRX,X)=$P(LRSB(LRSB),U)
  1. . S LREDIT=0,LRFLG=$P(LRSB(LRSB),U,2)
  1. . I $$GET1^DID(63.04,LRSB,"","TYPE","","LRERR")="SET" D
  1. . . S X=$$EXTERNAL^DILFD(63.04,LRSB,"",LRX)
  1. . . I X="" S X=LRX
  1. . W ?44," ",@LRFP," ",LRFLG,?56," ",$P(LRNG,U,7)
  1. . S X=LRX
  1. . I X=""!(X="canc")!(X="comment")!(X="pending") Q
  1. . S Y=0
  1. . I LRDEL'="" S LRQ=1 D XDELTACK^LRVERA K LRQ
  1. . W " "
  1. . I '$D(LRQ),$E(LRFLG,2)="*" D DISPFLG^LRVER4
  1. . I '$D(LRNUF) S LRLCT=LRLCT+1 S:$X>80 LRLCT=LRLCT+1 D:LRLCT>15 WT S:$E($G(Y))="^" LREND=1
  1. Q