LRMIEDZ ;DALOI/STAFF - MICROBIOLOGY EDIT ROUTINE ;05/11/09 10:44
;;5.2;LAB SERVICE;**295,350**;Sep 27, 1994;Build 230
;
; from LRVR and option LRMIEDZ
;
BEGIN ;
S LREND=0,LRACC="",LRSS="MI",LRVT="RE"
K ^TMP("LA7HDR",$J)
D EN^LRPARAM,DATE
;
;
END ; from LRFAST,LRVER
;
I $G(LRCSQ)'="",$O(^XTMP("LRCAP",LRCSQ,DUZ,0)) D STD^LRCAPV
;
;
ANN ;
;
D:$P(LRPARAM,U,14) ANN^LRCAPV ; Force workload program
K DD,DR,GLB,LRCAPMS,LRCDEF,LRCDEF0,LRCNT,LRCODE,LRCODEN,LRCSQ,LRCY,LRP,LRPN,LRQC,LRSSC,LRSSCX,LRSTD,LRT,LRTIME,NODE,NODE0,ZTSK
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
K LRODT,LRPTP,LRSAME,LRSB,LRSCREEN,LRSN,LRSPEC,LRSS,LRTEC,LRTS,LRTX,LRUNDO,LRWRD,N,PNM,POP,S,SEX,SSN,X,Y,Z
K ^TMP("LA7HDR",$J)
Q
;
;
DATE ;
;
D ENA^LRWU4("MI") Q:LRAA<1 D:$P(LRPARAM,U,14) ^LRCAPV G:LREND ANN
K DIC
S DIC=60,DIC("S")="I $P(^(0),U,4)=""MI""",DIC(0)="AEMOQ",DIC("A")="Select TEST/PROCEDURE: "
D ^DIC K DIC Q:$D(DUOUT) S LRPTP=+Y
I Y<1 W !,"None Preselected",!,"Accession # ",LRAN
S LRMIDEF=$P(^LAB(69.9,1,1),U,10),LRMIOTH=$P(^(1),U,11)
D ^LRMIEDZ2
Q
;
;
UNDO ; from LRMIEDZ2
;
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)=""
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)=""
;
D UPDATE^LRPXRM(LRDFN,"MI",LRIDT)
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRMIEDZ 1581 printed Oct 16, 2024@18:17:45 Page 2
LRMIEDZ ;DALOI/STAFF - MICROBIOLOGY EDIT ROUTINE ;05/11/09 10:44
+1 ;;5.2;LAB SERVICE;**295,350**;Sep 27, 1994;Build 230
+2 ;
+3 ; from LRVR and option LRMIEDZ
+4 ;
BEGIN ;
+1 SET LREND=0
SET LRACC=""
SET LRSS="MI"
SET LRVT="RE"
+2 KILL ^TMP("LA7HDR",$JOB)
+3 DO EN^LRPARAM
DO DATE
+4 ;
+5 ;
END ; from LRFAST,LRVER
+1 ;
+2 IF $GET(LRCSQ)'=""
IF $ORDER(^XTMP("LRCAP",LRCSQ,DUZ,0))
DO STD^LRCAPV
+3 ;
+4 ;
ANN ;
+1 ;
+2 ; Force workload program
if $PIECE(LRPARAM,U,14)
DO ANN^LRCAPV
+3 KILL DD,DR,GLB,LRCAPMS,LRCDEF,LRCDEF0,LRCNT,LRCODE,LRCODEN,LRCSQ,LRCY,LRP,LRPN,LRQC,LRSSC,LRSSCX,LRSTD,LRT,LRTIME,NODE,NODE0,ZTSK
+4 KILL %,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
+5 KILL LRODT,LRPTP,LRSAME,LRSB,LRSCREEN,LRSN,LRSPEC,LRSS,LRTEC,LRTS,LRTX,LRUNDO,LRWRD,N,PNM,POP,S,SEX,SSN,X,Y,Z
+6 KILL ^TMP("LA7HDR",$JOB)
+7 QUIT
+8 ;
+9 ;
DATE ;
+1 ;
+2 DO ENA^LRWU4("MI")
if LRAA<1
QUIT
if $PIECE(LRPARAM,U,14)
DO ^LRCAPV
if LREND
GOTO ANN
+3 KILL DIC
+4 SET DIC=60
SET DIC("S")="I $P(^(0),U,4)=""MI"""
SET DIC(0)="AEMOQ"
SET DIC("A")="Select TEST/PROCEDURE: "
+5 DO ^DIC
KILL DIC
if $DATA(DUOUT)
QUIT
SET LRPTP=+Y
+6 IF Y<1
WRITE !,"None Preselected",!,"Accession # ",LRAN
+7 SET LRMIDEF=$PIECE(^LAB(69.9,1,1),U,10)
SET LRMIOTH=$PIECE(^(1),U,11)
+8 DO ^LRMIEDZ2
+9 QUIT
+10 ;
+11 ;
UNDO ; from LRMIEDZ2
+1 ;
+2 SET $PIECE(^LR(LRDFN,"MI",LRIDT,0),U,9)=1
SET $PIECE(^(0),U,3,4)=U
SET $PIECE(^LRO(68,LRAA,1,LRAD,1,LRAN,3),U,4)=""
+3 SET $PIECE(^LRO(68,LRAA,1,LRAD,1,+LRAN,4,LRTS,0),U,4,5)=DUZ_U_DT
SET ^LRO(68,LRAA,1,LRAD,1,"AD",DT,+LRAN)=""
SET ^LRO(68,LRAA,1,LRAD,1,"AC",DT,+LRAN)=""
+4 ;
+5 DO UPDATE^LRPXRM(LRDFN,"MI",LRIDT)
+6 ;
+7 QUIT
