source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRCAPV2.m@ 1383

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