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

LRMIEDZ.m

Go to the documentation of this file.
  1. LRMIEDZ ;DALOI/STAFF - MICROBIOLOGY EDIT ROUTINE ;05/11/09 10:44
  1. ;;5.2;LAB SERVICE;**295,350**;Sep 27, 1994;Build 230
  1. ;
  1. ; from LRVR and option LRMIEDZ
  1. ;
  1. BEGIN ;
  1. S LREND=0,LRACC="",LRSS="MI",LRVT="RE"
  1. K ^TMP("LA7HDR",$J)
  1. D EN^LRPARAM,DATE
  1. ;
  1. ;
  1. END ; from LRFAST,LRVER
  1. ;
  1. I $G(LRCSQ)'="",$O(^XTMP("LRCAP",LRCSQ,DUZ,0)) D STD^LRCAPV
  1. ;
  1. ;
  1. ANN ;
  1. ;
  1. D:$P(LRPARAM,U,14) ANN^LRCAPV ; Force workload program
  1. K DD,DR,GLB,LRCAPMS,LRCDEF,LRCDEF0,LRCNT,LRCODE,LRCODEN,LRCSQ,LRCY,LRP,LRPN,LRQC,LRSSC,LRSSCX,LRSTD,LRT,LRTIME,NODE,NODE0,ZTSK
  1. K %,A6,AGE,C,D,D0,D1,DA,DFN,DIC,DIE,DLAYGO,DOB,DTOUT,DUOUT,DX,I,II,J,K,LRAA,LRACC,LRAD,LRANOK,LRBG0,LRBUG,LRCAPOK,LRCDT,LRDFN,LRDPF,LREAL,LREND,LRFIFO,LRI,LRIDT,LRLLOC,LRMIDEF,LRMIOTH,LRNB,LRODA,LRODIE,LRVT
  1. K LRODT,LRPTP,LRSAME,LRSB,LRSCREEN,LRSN,LRSPEC,LRSS,LRTEC,LRTS,LRTX,LRUNDO,LRWRD,N,PNM,POP,S,SEX,SSN,X,Y,Z
  1. K ^TMP("LA7HDR",$J)
  1. Q
  1. ;
  1. ;
  1. DATE ;
  1. ;
  1. D ENA^LRWU4("MI") Q:LRAA<1 D:$P(LRPARAM,U,14) ^LRCAPV G:LREND ANN
  1. K DIC
  1. S DIC=60,DIC("S")="I $P(^(0),U,4)=""MI""",DIC(0)="AEMOQ",DIC("A")="Select TEST/PROCEDURE: "
  1. D ^DIC K DIC Q:$D(DUOUT) S LRPTP=+Y
  1. I Y<1 W !,"None Preselected",!,"Accession # ",LRAN
  1. S LRMIDEF=$P(^LAB(69.9,1,1),U,10),LRMIOTH=$P(^(1),U,11)
  1. D ^LRMIEDZ2
  1. Q
  1. ;
  1. ;
  1. UNDO ; from LRMIEDZ2
  1. ;
  1. S $P(^LR(LRDFN,"MI",LRIDT,0),U,9)=1,$P(^(0),U,3,4)=U,$P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),U,4)=""
  1. S $P(^LRO(68,LRAA,1,LRAD,1,+LRAN,4,LRTS,0),U,4,5)=DUZ_U_DT,^LRO(68,LRAA,1,LRAD,1,"AD",DT,+LRAN)="",^LRO(68,LRAA,1,LRAD,1,"AC",DT,+LRAN)=""
  1. ;
  1. D UPDATE^LRPXRM(LRDFN,"MI",LRIDT)
  1. ;
  1. Q