LRMIUT ;DALOI/STAFF - MICROBIOLOGY UTILITIES ;Sep 29, 2008
;;5.2;LAB SERVICE;**254,266,350**;Sep 27, 1994;Build 230
;
; File 42/10039
; Reference to ^%ZTLOAD supported by DBIA #10063
; Reference to ^DIC supported by DBIA #10006
; Reference to IN5^VADPT supported by DBIA #10061
;
STF ;from LRMIEDZ2, LRMISTF1
;
N D
S D=0
I $G(LRSB)'="",$D(^LR(LRDFN,"MI",LRIDT,LRSB)) S D=$P(^(LRSB),U),^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN)=DUZ_U_D
I $P(LRPARAM,U,5),D D TSKM
;
; CareVue supported ward - now tasking routine for CareVue-PWC-10/00
I D>0 D
. N LR7DLOC
. D IN5^VADPT S LR7DLOC=$G(^DIC(42,+$P($G(VAIP(5)),"^"),44))
. I LR7DLOC>0,$D(^LAB(62.487,"C",LR7DLOC)) D ; good ward location
. . N LRH,LRSS,ZTRTN,ZTDTH,ZTSAVE,ZTIO,ZTSK,ZTDESC,ZTQUEUED,ZTREQ
. . S LRH="",LRSS="MI",ZTRTN="^LA7DLOC",ZTIO="",ZTDTH=$H,ZTSAVE("L*")="",ZTDESC="LAB AUTOMATION CAREVUE SUPPORTED WARDS"
. . D ^%ZTLOAD
Q
;
;
TSKM ; from LRMINEW1
N LRH,LRWRDVEW,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTSAVE
S LRH="",LRSS="MI",LRWRDVEW="",ZTRTN="DQ^LRTP",ZTIO="",ZTDTH=$H,ZTSAVE("L*")=""
D ^%ZTLOAD
Q
;
;
LRAA ; from LRMINEW, LRMIPLOG, LRMISEZ, LRMISTF, LRMIVER
N DIC
S DIC=68,DIC(0)="AEMOQ",DIC("S")="I $P(^(0),U,2)=""MI""" D ^DIC
S LRAA=+Y
Q
;
;
LRAN ; from LRMINEW1, LRMIPLOG, LRMISTF1, LRMIVER1
;
N DIR,DIRUT,DTOUT,DUOUT,J,K,X,Y
K LRAN
;
S DIR(0)="LOA^1:99999:0",DIR("A")="Enter #'s: "
F D Q:$D(DIRUT)
. K Y
. D ^DIR
. I $D(DIRUT) Q
. I $O(Y(""),-1)>50 W !,"Too many numbers selected, choose a smaller group" Q
. S J=""
. F S J=$O(Y(J)) Q:J="" D
. . F K=1:1 Q:$P(Y(J),",",K)="" S LRAN($P(Y(J),",",K))=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRMIUT 1661 printed Dec 13, 2024@02:17:41 Page 2
LRMIUT ;DALOI/STAFF - MICROBIOLOGY UTILITIES ;Sep 29, 2008
+1 ;;5.2;LAB SERVICE;**254,266,350**;Sep 27, 1994;Build 230
+2 ;
+3 ; File 42/10039
+4 ; Reference to ^%ZTLOAD supported by DBIA #10063
+5 ; Reference to ^DIC supported by DBIA #10006
+6 ; Reference to IN5^VADPT supported by DBIA #10061
+7 ;
STF ;from LRMIEDZ2, LRMISTF1
+1 ;
+2 NEW D
+3 SET D=0
+4 IF $GET(LRSB)'=""
IF $DATA(^LR(LRDFN,"MI",LRIDT,LRSB))
SET D=$PIECE(^(LRSB),U)
SET ^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN)=DUZ_U_D
+5 IF $PIECE(LRPARAM,U,5)
IF D
DO TSKM
+6 ;
+7 ; CareVue supported ward - now tasking routine for CareVue-PWC-10/00
+8 IF D>0
Begin DoDot:1
+9 NEW LR7DLOC
+10 DO IN5^VADPT
SET LR7DLOC=$GET(^DIC(42,+$PIECE($GET(VAIP(5)),"^"),44))
+11 ; good ward location
IF LR7DLOC>0
IF $DATA(^LAB(62.487,"C",LR7DLOC))
Begin DoDot:2
+12 NEW LRH,LRSS,ZTRTN,ZTDTH,ZTSAVE,ZTIO,ZTSK,ZTDESC,ZTQUEUED,ZTREQ
+13 SET LRH=""
SET LRSS="MI"
SET ZTRTN="^LA7DLOC"
SET ZTIO=""
SET ZTDTH=$HOROLOG
SET ZTSAVE("L*")=""
SET ZTDESC="LAB AUTOMATION CAREVUE SUPPORTED WARDS"
+14 DO ^%ZTLOAD
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
+17 ;
TSKM ; from LRMINEW1
+1 NEW LRH,LRWRDVEW,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTSAVE
+2 SET LRH=""
SET LRSS="MI"
SET LRWRDVEW=""
SET ZTRTN="DQ^LRTP"
SET ZTIO=""
SET ZTDTH=$HOROLOG
SET ZTSAVE("L*")=""
+3 DO ^%ZTLOAD
+4 QUIT
+5 ;
+6 ;
LRAA ; from LRMINEW, LRMIPLOG, LRMISEZ, LRMISTF, LRMIVER
+1 NEW DIC
+2 SET DIC=68
SET DIC(0)="AEMOQ"
SET DIC("S")="I $P(^(0),U,2)=""MI"""
DO ^DIC
+3 SET LRAA=+Y
+4 QUIT
+5 ;
+6 ;
LRAN ; from LRMINEW1, LRMIPLOG, LRMISTF1, LRMIVER1
+1 ;
+2 NEW DIR,DIRUT,DTOUT,DUOUT,J,K,X,Y
+3 KILL LRAN
+4 ;
+5 SET DIR(0)="LOA^1:99999:0"
SET DIR("A")="Enter #'s: "
+6 FOR
Begin DoDot:1
+7 KILL Y
+8 DO ^DIR
+9 IF $DATA(DIRUT)
QUIT
+10 IF $ORDER(Y(""),-1)>50
WRITE !,"Too many numbers selected, choose a smaller group"
QUIT
+11 SET J=""
+12 FOR
SET J=$ORDER(Y(J))
if J=""
QUIT
Begin DoDot:2
+13 FOR K=1:1
if $PIECE(Y(J),",",K)=""
QUIT
SET LRAN($PIECE(Y(J),",",K))=""
End DoDot:2
End DoDot:1
if $DATA(DIRUT)
QUIT
+14 QUIT
