LRCAPV2 ;SLC/AM/DALISC/FHS-STORE WORKLOAD FROM 68 INTO ^LRO(64.1 ;5/2/91 09:03
;;5.2;LAB SERVICE;**105,119,153,221**;Sep 27, 1994
EN ;from LRNIGHT
S:$D(ZTQUEUED) ZTREQ="@"
S ZTIO="",ZTRTN="ORU^LA7VMSG",ZTDTH=$H,ZTDESC="SEND LAB LEDI HL7 MESSAGE" D ^%ZTLOAD
S ZTIO="",ZTRTN="LRCAPPH",ZTDTH=$H,ZTDESC="COLLECT PHLEBOTOMY CAP WORKLOAD" D ^%ZTLOAD
I $P($G(^LAB(69.9,1,0)),U,14) S ZTIO="",ZTRTN="LRCAPBB",ZTDTH=$H,ZTDESC="COLLECT BLOOD BANK WORKLOAD" D ^%ZTLOAD
L +^LRO(68,"AA"):1 I '$T G CLEAN
I $D(XRTL) S XRTN="LRCAPV2" D T0^%ZOSV ; START RESPONSE TIME LOGGING
S $P(^LAB(69.9,1,"NITE"),U)=$$NOW^LRAFUNC1
EN1 S (LRII,LRTS,LRCC,LRIN,LRCDT,LRCTM)=""
F S LRII=$O(^LRO(68,"AA",LRII)) Q:'(LRII]"") S LRAA=$P(LRII,"|"),LRAD=$P(LRII,"|",2),LRAN=$P(LRII,"|",3),LRTS=$P(LRII,"|",4) D LRACC K ^LRO(68,"AA",LRII)
S $P(^LAB(69.9,1,"NITE"),U)=""
D CLEAN I $D(XRT0) S XRTN="EN+5^LRCAPV2" D T1^%ZOSV ; STOP RESPONSE TIME LOGGING
Q
LRACC ;
I '$P($G(^LRO(68,+LRAA,0)),U,16) Q
I (LRAA="")!(LRAD="")!(LRAN="")!(LRTS="") D DUMPIT Q
S LRX=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) I '($L(LRX)) D DUMPIT Q
S LRSPEC=+$G(^LRO(68,LRAA,1,LRAD,1,LRAN,5,1,0))
S LRREC=+$P(LRX,U),LRFNUM=+$P(LRX,U,2),LROAD=$P(LRX,U,3),LROAD1=$P(LRX,U,4),LROAD2=$P(LRX,U,5)
S LRRRL=$E($P(LRX,U,7),1,20),LRRRL1=$P(LRX,U,8),LRRRL2=$P(LRX,U,9),LRRRL3=$P(LRX,U,10),LRRRL4=$P(LRX,U,11),LROL=$P(LRX,U,13)
S:LRRRL4="" LRRRL4="Z"
I (LRFNUM="")!(LRREC="") D DUMPIT Q
S LRX=$G(^LRO(68,LRAA,0)) I '($L(LRX)) D DUMPIT Q
S LRLD=$S($L($P(LRX,"^",19)):$P(LRX,"^",19),1:"CP")
S LRACC=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,.2)) I '($L(LRACC)) D DUMPIT Q
S LRX=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)) I '($L(LRX)) D DUMPIT Q
S LRIDT=$P(LRX,U,5),LRFILE=$S(LRFNUM=2:"DPT(",1:"")
I LRFILE="" S:$D(^DIC(LRFNUM,0,"GL"))=1 LRFILE=^("GL")
S LRREC=$S($D(^LR(LRREC,0))#2:$P(^LR(LRREC,0),"^",3),1:"")
S LRFILE=LRREC_";"_$S($E(LRFILE,1)=U:$E(LRFILE,2,99),1:LRFILE)
S LRX=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTS,0)) I '($L(LRX)) D DUMPIT Q
I $E($P(LRX,U,6))="*" D DUMPIT Q
S LRUG=$P(LRX,U,2)
F LRCC=0:0 S LRCC=+$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTS,1,LRCC)) Q:LRCC<1 D LRCAPC
Q
LRCAPC ;
S LRX=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTS,1,LRCC,0)) I '$L(LRX) D DUMPIT Q
; CHECK COUNTED FOR WORKLOAD IN FILE #68
Q:$P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTS,1,LRCC,0),U,3)
S LRCDT=$P(LRX,U,6),LRCTM=$P(LRCDT,".",2),LRCDT=$P(LRCDT,".") S:LRCTM="" LRCTM="08"
S LRTEC=$P(LRX,U,7),LRIN=$P(LRX,U,8),LRMA=$P(LRX,U,9),LRLSS=$P(LRX,U,10),LRCNT=$P(LRX,U,2),LRWA=$P(LRX,U,11)
S:LRIN="" LRIN=$P($G(^XMB(1,1,"XUS")),U,17)
S:'LRCNT LRCNT=1 S (LRUW,LRCWT)=0
I $D(^LAM(LRCC,0))#2 S LRX=^(0),LRUW=$P(LRX,"^",3),LRCWT=$P(LRX,"^",11)
I (LRCC="")!(LRCDT="")!(LRIN="") D DUMPIT Q
D ^LRCAPV3
S X=^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTS,1,LRCC,0),$P(X,"^",3)=1,$P(X,"^",4)=$P(X,"^",4)+$P(X,"^",2),^(0)=X
Q
DUMPIT ;
Q ;Comment this line to set trap
S LRERR=$S($D(^TMP("LR WL ERRORS",0))#2:$P(^(0),U,3),1:0)+1,^TMP("LR WL ERRORS",0)=U_U_LRERR
S LRESTR="AA= "_$S($D(LRAA):LRAA,1:"")_" AD= "_$S($D(LRAD):LRAD,1:"")_" AN= "_$S($D(LRAN):LRAN,1:"")_" TS= "_$S($D(LRTS):LRTS,1:"")_" CC= "_$S($D(LRCC):LRCC,1:"")_" IN= "_$S($D(LRIN):LRIN,1:"")
S LRESTR=LRESTR_" CDT= "_$S($D(LRCDT):LRCDT,1:"")_" CT= "_$S($D(LRCTM):LRCTM,1:"")
S ^TMP("LR WL ERRORS",LRERR,$H)=LRESTR
Q
CLEAN ;
L -^LRO(68,"AA")
I $D(ZTQUEUED) S ZTREQ="@"
K LRAA,LRACC,LRAD,LRAN,LRCC,LRCDT,LRCNT,LRCTM,LRFILE,LRFNUM,LRIDT,LRIN,LRLSS,LRMA,LROAD,LROL,LRRREC,LRRRL,LRTEC
K LRTS,LRUG,LRX,LRZCNT,LRERR,LRQC,LRII,LRNT,LRCWT,LRREC,LRUW,X,LRESTR,LRWA,%,LRLD,LROAD1,LROAD2,LRRRL1,LRRRL2,LRRRL3,LRRRL4
Q
TRAP ;
S $P(^LAB(69.9,1,"NITE"),U)="ERROR"_$P(^("NITE"),U) D @^%ZOSF("ERRTN")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRCAPV2 3709 printed Nov 22, 2024@17:23:34 Page 2
LRCAPV2 ;SLC/AM/DALISC/FHS-STORE WORKLOAD FROM 68 INTO ^LRO(64.1 ;5/2/91 09:03
+1 ;;5.2;LAB SERVICE;**105,119,153,221**;Sep 27, 1994
EN ;from LRNIGHT
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 SET ZTIO=""
SET ZTRTN="ORU^LA7VMSG"
SET ZTDTH=$HOROLOG
SET ZTDESC="SEND LAB LEDI HL7 MESSAGE"
DO ^%ZTLOAD
+3 SET ZTIO=""
SET ZTRTN="LRCAPPH"
SET ZTDTH=$HOROLOG
SET ZTDESC="COLLECT PHLEBOTOMY CAP WORKLOAD"
DO ^%ZTLOAD
+4 IF $PIECE($GET(^LAB(69.9,1,0)),U,14)
SET ZTIO=""
SET ZTRTN="LRCAPBB"
SET ZTDTH=$HOROLOG
SET ZTDESC="COLLECT BLOOD BANK WORKLOAD"
DO ^%ZTLOAD
+5 LOCK +^LRO(68,"AA"):1
IF '$TEST
GOTO CLEAN
+6 ; START RESPONSE TIME LOGGING
IF $DATA(XRTL)
SET XRTN="LRCAPV2"
DO T0^%ZOSV
+7 SET $PIECE(^LAB(69.9,1,"NITE"),U)=$$NOW^LRAFUNC1
EN1 SET (LRII,LRTS,LRCC,LRIN,LRCDT,LRCTM)=""
+1 FOR
SET LRII=$ORDER(^LRO(68,"AA",LRII))
if '(LRII]"")
QUIT
SET LRAA=$PIECE(LRII,"|")
SET LRAD=$PIECE(LRII,"|",2)
SET LRAN=$PIECE(LRII,"|",3)
SET LRTS=$PIECE(LRII,"|",4)
DO LRACC
KILL ^LRO(68,"AA",LRII)
+2 SET $PIECE(^LAB(69.9,1,"NITE"),U)=""
+3 ; STOP RESPONSE TIME LOGGING
DO CLEAN
IF $DATA(XRT0)
SET XRTN="EN+5^LRCAPV2"
DO T1^%ZOSV
+4 QUIT
LRACC ;
+1 IF '$PIECE($GET(^LRO(68,+LRAA,0)),U,16)
QUIT
+2 IF (LRAA="")!(LRAD="")!(LRAN="")!(LRTS="")
DO DUMPIT
QUIT
+3 SET LRX=$GET(^LRO(68,LRAA,1,LRAD,1,LRAN,0))
IF '($LENGTH(LRX))
DO DUMPIT
QUIT
+4 SET LRSPEC=+$GET(^LRO(68,LRAA,1,LRAD,1,LRAN,5,1,0))
+5 SET LRREC=+$PIECE(LRX,U)
SET LRFNUM=+$PIECE(LRX,U,2)
SET LROAD=$PIECE(LRX,U,3)
SET LROAD1=$PIECE(LRX,U,4)
SET LROAD2=$PIECE(LRX,U,5)
+6 SET LRRRL=$EXTRACT($PIECE(LRX,U,7),1,20)
SET LRRRL1=$PIECE(LRX,U,8)
SET LRRRL2=$PIECE(LRX,U,9)
SET LRRRL3=$PIECE(LRX,U,10)
SET LRRRL4=$PIECE(LRX,U,11)
SET LROL=$PIECE(LRX,U,13)
+7 if LRRRL4=""
SET LRRRL4="Z"
+8 IF (LRFNUM="")!(LRREC="")
DO DUMPIT
QUIT
+9 SET LRX=$GET(^LRO(68,LRAA,0))
IF '($LENGTH(LRX))
DO DUMPIT
QUIT
+10 SET LRLD=$SELECT($LENGTH($PIECE(LRX,"^",19)):$PIECE(LRX,"^",19),1:"CP")
+11 SET LRACC=$GET(^LRO(68,LRAA,1,LRAD,1,LRAN,.2))
IF '($LENGTH(LRACC))
DO DUMPIT
QUIT
+12 SET LRX=$GET(^LRO(68,LRAA,1,LRAD,1,LRAN,3))
IF '($LENGTH(LRX))
DO DUMPIT
QUIT
+13 SET LRIDT=$PIECE(LRX,U,5)
SET LRFILE=$SELECT(LRFNUM=2:"DPT(",1:"")
+14 IF LRFILE=""
if $DATA(^DIC(LRFNUM,0,"GL"))=1
SET LRFILE=^("GL")
+15 SET LRREC=$SELECT($DATA(^LR(LRREC,0))#2:$PIECE(^LR(LRREC,0),"^",3),1:"")
+16 SET LRFILE=LRREC_";"_$SELECT($EXTRACT(LRFILE,1)=U:$EXTRACT(LRFILE,2,99),1:LRFILE)
+17 SET LRX=$GET(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTS,0))
IF '($LENGTH(LRX))
DO DUMPIT
QUIT
+18 IF $EXTRACT($PIECE(LRX,U,6))="*"
DO DUMPIT
QUIT
+19 SET LRUG=$PIECE(LRX,U,2)
+20 FOR LRCC=0:0
SET LRCC=+$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTS,1,LRCC))
if LRCC<1
QUIT
DO LRCAPC
+21 QUIT
LRCAPC ;
+1 SET LRX=$GET(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTS,1,LRCC,0))
IF '$LENGTH(LRX)
DO DUMPIT
QUIT
+2 ; CHECK COUNTED FOR WORKLOAD IN FILE #68
+3 if $PIECE(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTS,1,LRCC,0),U,3)
QUIT
+4 SET LRCDT=$PIECE(LRX,U,6)
SET LRCTM=$PIECE(LRCDT,".",2)
SET LRCDT=$PIECE(LRCDT,".")
if LRCTM=""
SET LRCTM="08"
+5 SET LRTEC=$PIECE(LRX,U,7)
SET LRIN=$PIECE(LRX,U,8)
SET LRMA=$PIECE(LRX,U,9)
SET LRLSS=$PIECE(LRX,U,10)
SET LRCNT=$PIECE(LRX,U,2)
SET LRWA=$PIECE(LRX,U,11)
+6 if LRIN=""
SET LRIN=$PIECE($GET(^XMB(1,1,"XUS")),U,17)
+7 if 'LRCNT
SET LRCNT=1
SET (LRUW,LRCWT)=0
+8 IF $DATA(^LAM(LRCC,0))#2
SET LRX=^(0)
SET LRUW=$PIECE(LRX,"^",3)
SET LRCWT=$PIECE(LRX,"^",11)
+9 IF (LRCC="")!(LRCDT="")!(LRIN="")
DO DUMPIT
QUIT
+10 DO ^LRCAPV3
+11 SET X=^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTS,1,LRCC,0)
SET $PIECE(X,"^",3)=1
SET $PIECE(X,"^",4)=$PIECE(X,"^",4)+$PIECE(X,"^",2)
SET ^(0)=X
+12 QUIT
DUMPIT ;
+1 ;Comment this line to set trap
QUIT
+2 SET LRERR=$SELECT($DATA(^TMP("LR WL ERRORS",0))#2:$PIECE(^(0),U,3),1:0)+1
SET ^TMP("LR WL ERRORS",0)=U_U_LRERR
+3 SET LRESTR="AA= "_$SELECT($DATA(LRAA):LRAA,1:"")_" AD= "_$SELECT($DATA(LRAD):LRAD,1:"")_" AN= "_$SELECT($DATA(LRAN):LRAN,1:"")_" TS= "_$SELECT($DATA(LRTS):LRTS,1:"")_" CC= "_$SELECT($DATA(LRCC):LRCC,1:"")_" IN= "_$SELECT($DATA(LRIN):LRIN,1:"")
+4 SET LRESTR=LRESTR_" CDT= "_$SELECT($DATA(LRCDT):LRCDT,1:"")_" CT= "_$SELECT($DATA(LRCTM):LRCTM,1:"")
+5 SET ^TMP("LR WL ERRORS",LRERR,$HOROLOG)=LRESTR
+6 QUIT
CLEAN ;
+1 LOCK -^LRO(68,"AA")
+2 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 KILL LRAA,LRACC,LRAD,LRAN,LRCC,LRCDT,LRCNT,LRCTM,LRFILE,LRFNUM,LRIDT,LRIN,LRLSS,LRMA,LROAD,LROL,LRRREC,LRRRL,LRTEC
+4 KILL LRTS,LRUG,LRX,LRZCNT,LRERR,LRQC,LRII,LRNT,LRCWT,LRREC,LRUW,X,LRESTR,LRWA,%,LRLD,LROAD1,LROAD2,LRRRL1,LRRRL2,LRRRL3,LRRRL4
+5 QUIT
TRAP ;
+1 SET $PIECE(^LAB(69.9,1,"NITE"),U)="ERROR"_$PIECE(^("NITE"),U)
DO @^%ZOSF("ERRTN")
+2 QUIT
