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

LRVER.m

Go to the documentation of this file. 
  1. LRVER ;DALOI/STAFF - LAB ROUTINE DATA VERIFICATION ;11/23/11  12:08
  1.  ;;5.2;LAB SERVICE;**153,286,350**;Sep 27, 1994;Build 230
  1.  ;
  1.  D ^LRPARAM
  1.  S LRCW=8,LREND=0,LRPANEL=0,LRUID=""
  1.  K DIC,LRPER,DUOUT
  1.  D REV
  1.  I LREND D QUIT Q
  1.  D VERDIS
  1.  I LREND D QUIT Q
  1.  D CMTDSP^LRVERA
  1.  S (LRAA,LRAD,LRAN)=0
  1.  N LRVBY
  1.  S LRVBY=$$GET^XPAR("USR^DIV^PKG","LR VER EM VERIFY BY UID",1,"Q")
  1.  I LRVBY<2 S LRVBY=$$SELBY^LRWU4("Verify by",LRVBY+1)
  1.  D:LRVBY=1 ^LRVERA D:LRVBY=2 UID^LRVERA
  1.  I 'LRVBY!(LRAA<1) D QUIT Q
  1.  S X=$$SELPL^LRVERA(DUZ(2))
  1.  I X<1 D QUIT Q
  1.  I X'=DUZ(2) N LRDUZ S LRDUZ(2)=X
  1.  I $P(LRPARAM,U,14),$P($G(^LRO(68,LRAA,0)),U,16) D ^LRCAPV G QUIT:$G(LREND)
  1. SLOW S LRSS=$P(^LRO(68,LRAA,0),U,2)
  1.  ;
  1.  I LRSS="MI" D  Q
  1.  . S X=DUZ D DUZ^LRX S LRTEC=LRUSI
  1.  . S LRPTP=-1,LRMIDEF=$P(^LAB(69.9,1,1),U,10),LRMIOTH=$P(^(1),U,11)
  1.  . D ^LRMIEDZ2,END^LRMIEDZ,QUIT
  1.  ;
  1.  ;
  1.  I LRSS'="CH" D QUIT Q
  1.  ;
  1.  ; The rest of the code only works on the "CH" area.
  1. DAT I LRAD<1 D ADATE^LRWU
  1.  Q:LRAD<1
  1.  S %H=$H-$P(^LAB(69.9,1,0),U,7) D YMD^%DTC S LRTM60=9999999-X
  1.  I LRAN>0 D WLN1 G QUIT:$G(LREND) G L11
  1.  I $P(^LRO(68,LRAA,0),U,3)="D" S I=0 F  S I=$O(^LRO(68,LRAA,1,LRAD,1,I)) Q:I<1  I $D(^LRO(68,LRAA,1,LRAD,1,I,3)),'$P(^(3),U,4) S LRAN=I Q
  1.  S:$D(^LRO(68,LRAA,1,LRAD,2))&(LRAN<1) LRAN=$P(^(2),U,4)
  1.  ;
  1. L10 K LRTEST,LRSET,LRLDT,DIC,LRNAME,LRNG,LRDEL,T,LRTX,LRFP,LRAB,LRVERVER,Y,Z
  1.  G QUIT:$G(LREND) D WLN G QUIT:$G(LREND)
  1.  ;
  1. L11 I $D(LRFASTS) D ^LRVER1,SLOWK^LRFASTS Q
  1.  D ^LRVER1,NEXT
  1.  G L10
  1.  ;
  1. YN S DUOUT=0 S:'$D(%) %=1 D YN^DICN S:%<0 DUOUT=1 W:%=0 !,"Answer with a YES or NO or '^' to exit" Q:%  G YN
  1.  ;
  1. WLN I LRVBY=2 S:LRAN<1 LRUID="" S:$L(LRAN) LRUID=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3)),"^") D UID^LRVERA G LREND:LRUID="" G WLN1
  1.  ;
  1.  S:LRAN<1 LRAN=""
  1.  K DIR,DIRUT,DTOUT,DUOUT
  1.  S DIR(0)="NAO^1:999999:0"
  1.  S DIR("A")="Accession NUMBER: ",DIR("?")="^D LW^LRVR"
  1.  I LRAN'="" S DIR("B")=LRAN
  1.  D ^DIR K DIR
  1.  I $D(DIRUT) G LREND
  1.  S LRAN=Y
  1.  G WLN:LRAN=""
  1. WLN1 I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) W !,"Accession does not exist." D NEXT G WLN
  1.  S LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRORD=$S($D(^(.1)):^(.1),1:0),LRODT=+$S($P(^(0),U,4):$P(^(0),U,4),1:$P(^(0),U,3)),LRSN=+$P(^(0),U,5)
  1.  S LRUID=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3)),"^")
  1.  S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX
  1.  W !,PNM,?30,SSN
  1.  W:LRDPF=2 "   LOC:",$S($L(LRWRD):LRWRD,1:$S($L($P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,7)):$P(^(0),U,7),1:"??"))
  1.  W !
  1.  S LRCDT=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U)
  1.  ; If no lab arrival time then have user update order/accession
  1.  I '$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U,3) D
  1.  . N %DT,LRA1,LRA2,LRA3
  1.  . S %DT("B")=$$FMTE^XLFDT(LRCDT,"1")
  1.  . S LRSTATUS="C",LRA1=LRAA,LRA2=LRAD,LRA3=LRAN
  1.  . D P15^LROE1
  1.  . S LRAA=LRA1,LRAD=LRA2,LRAN=LRA3
  1.  . Q:LRCDT<1
  1.  . I '$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U,3) S $P(^(3),U,3)=$$NOW^XLFDT
  1.  ; If user did not update then go to next accession
  1.  I '$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U,3) D NEXT G WLN
  1.  S LRCDT=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U)
  1.  I $G(LRCDT)<1 S LRCDT=1 D NEXT G WLN
  1.  ; Check for valid pointer to file #63 and entry in file #63.
  1.  S LRIDT=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U,5)
  1.  I LRIDT<1 D  G WLN
  1.  . W !,">>>>ERROR - NO POINTER TO FILE #63 - PLEASE NOTIFY SYSTEM MANAGER<<<<<",!
  1.  . D NEXT
  1.  I '$D(^LR(LRDFN,"CH",LRIDT,0)) D  G WLN
  1.  . W !,">>>>ERROR - NO ENTRY IN FILE #63 - PLEASE NOTIFY SYSTEM MANAGER<<<<<",!
  1.  . D NEXT
  1.  I $D(^LRO(69,LRODT,1,LRSN)),'$D(^(LRSN,1)) W !,"This Order # has not been collected",$C(7) D NEXT G WLN
  1.  I $D(^LRO(69,LRODT,1,LRSN,1)),$P(^LRO(69,LRODT,1,LRSN,1),U,4)'="C" W !,"You cannot verify an accession which has not been collected.",$C(7) D NEXT G WLN
  1.  Q
  1.  ;
  1.  ;
  1. LREND I $D(^LRO(68,LRAA,1,LRAD,0)) S:'$D(^(2)) ^(2)="^^" S ^(2)=$P(^(2),U,1,3)_U_LRAN_U_$P(^(2),U,5,99)
  1.  S LREND=1 K ^TMP("LR",$J,"TMP"),LRORD,LRM
  1.  Q
  1.  ;
  1.  ;
  1. NEXT ;
  1.  S LRAN=$O(^LRO(68,LRAA,1,LRAD,1,LRAN))
  1.  I LRAN<1 W !,"LAST IN WORK LIST" S LRAN="",LREND=1
  1.  Q
  1.  ;
  1.  ;
  1. QUIT ;
  1.  I $D(LRCSQ),'$O(^XTMP("LRCAP",LRCSQ,DUZ,0)) K ^XTMP("LRCAP",LRCSQ,DUZ),LRCSQ
  1.  I $D(LRCSQ),$D(LRAA),$P($G(^LRO(68,+LRAA,0)),U,16) D STD^LRCAPV
  1.  ;
  1. SLOQ ;
  1.  D STOP^LRCAPV,^LRCAPV2
  1.  K %,A,AGE,D1,DFN,DIC,DIE,DIR,DL,DLAYGO,DOB,DQ,DR,DX,I,J,LRACC,LRVF,LRCDT,LRCW,LRDAT,LRDFN,LRDPF,LRDV,LRDVF,LREAL,LREDIT,LREND,LRFLG,LRIDT,LRINI,LRLCT,LRLLOC,LRMETH,LRNG2,LRNG3,LRAD,LRAN,LRSPEC,LRPER,LRALL
  1.  K LRNG4,LRNG5,LRNT,LRNTN,LRNX,LRODT,LROUTINE,LROWLE,LRSAMP,LRSN,LRSS,LRSSP,LRSUB,LRTEC,LRTN,LRTS,LRUSI,LRUSNM,LRWRD,LRXD,LRXDP,PNM,S,SEX,SSN,X,X1,X2,X3,Y,Z
  1.  K %DT,%H,%X,%Y,B,C,D,DA,DR,G,G1,G2,G4,LRACD,LRAOD,LREDT,LREXEC,LRGVP,LRIOZERO,LRM,LRMA,LRNAME,LRORD,LRPLOC,LRSA,LRSB,LRSDT,LRSSQ,LRTK,LRTX,LRURG,LRVOL,LRVRM,LRWDTL,LRXDH,N,POP,T1,X9,Z1,Z2,^TMP("LR",$J)
  1.  K LRT,LRCFL,D0,GLB,LRAA,LRCNT,LRCODE,LRCODEN,LRCMTDSP,LRCWT,LRI,LRNOW,LRP,LRPN,LRQC,LRSSC,LRSSCX,LRSTD,NODE,NODE0,NOW,S2,ZTSK,Y,LRTIME,LRMAX2,LRMAXX,LRMX,LRODTSV,LRSNSV,LRSPN,LRTNSV,LRTY
  1.  K W,Y,Z,Z1,Z2,I1,LRALERT,LRDIYCNT,LRNOCODE,LRREP,LRSTATUS,LRUN,LRX,LRTIM,LRAL,LRPANEL,LRTM60,LRNDISP
  1.  D KVA^VADPT K LRIDIV,LROLLOC,LRORIFN,LRPRAC,LRRB,LRSD,LRTREA,LRTT,LRUID
  1.  K NAME,LRSUFO,LRCSQQ
  1.  Q
  1.  ;
  1.  ;
  1. REV ; Ask if user wants to review data before and after editing
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  S DIR(0)="YO",DIR("B")="YES"
  1.  S DIR("A")="Do you want to review the data before and after you edit"
  1.  S DIR("?",1)="Answer YES, and the data will be displayed in its entirety as a panel before"
  1.  S DIR("?",2)="you edit if data already exists, and will be displayed after you edit."
  1.  S DIR("?")="NO, will skip the extra displays."
  1.  D ^DIR
  1.  I $D(DIRUT) S LREND=1
  1.  I Y=0 S LRPER=""
  1.  Q
  1.  ;
  1.  ;
  1. VERDIS ; Prevent test not selected by the user with verified data
  1.  ; entered from being displayed on the editing screens.
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  S DIR(0)="YO",DIR("B")="NO"
  1.  S DIR("A")="Do you wish to see all previously verified results"
  1.  S DIR("?",1)="Do you want to see every test that has results entered"
  1.  S DIR("?",2)="or only the test(s) you select to edit "
  1.  S DIR("?")="Answer with YES or NO"
  1.  D ^DIR
  1.  I $D(DIRUT) S LREND=1
  1.  I Y=0 S LRNDISP=1
  1.  Q