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

Last change on this file since 811 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.6 KB
Line 
1LRCAPV2 ;SLC/AM/DALISC/FHS-STORE WORKLOAD FROM 68 INTO ^LRO(64.1 ;5/2/91 09:03
2 ;;5.2;LAB SERVICE;**105,119,153,221**;Sep 27, 1994
3EN ;from LRNIGHT
4 S:$D(ZTQUEUED) ZTREQ="@"
5 S ZTIO="",ZTRTN="ORU^LA7VMSG",ZTDTH=$H,ZTDESC="SEND LAB LEDI HL7 MESSAGE" D ^%ZTLOAD
6 S ZTIO="",ZTRTN="LRCAPPH",ZTDTH=$H,ZTDESC="COLLECT PHLEBOTOMY CAP WORKLOAD" D ^%ZTLOAD
7 I $P($G(^LAB(69.9,1,0)),U,14) S ZTIO="",ZTRTN="LRCAPBB",ZTDTH=$H,ZTDESC="COLLECT BLOOD BANK WORKLOAD" D ^%ZTLOAD
8 L +^LRO(68,"AA"):1 I '$T G CLEAN
9 I $D(XRTL) S XRTN="LRCAPV2" D T0^%ZOSV ; START RESPONSE TIME LOGGING
10 S $P(^LAB(69.9,1,"NITE"),U)=$$NOW^LRAFUNC1
11EN1 S (LRII,LRTS,LRCC,LRIN,LRCDT,LRCTM)=""
12 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)
13 S $P(^LAB(69.9,1,"NITE"),U)=""
14 D CLEAN I $D(XRT0) S XRTN="EN+5^LRCAPV2" D T1^%ZOSV ; STOP RESPONSE TIME LOGGING
15 Q
16LRACC ;
17 I '$P($G(^LRO(68,+LRAA,0)),U,16) Q
18 I (LRAA="")!(LRAD="")!(LRAN="")!(LRTS="") D DUMPIT Q
19 S LRX=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) I '($L(LRX)) D DUMPIT Q
20 S LRSPEC=+$G(^LRO(68,LRAA,1,LRAD,1,LRAN,5,1,0))
21 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)
22 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)
23 S:LRRRL4="" LRRRL4="Z"
24 I (LRFNUM="")!(LRREC="") D DUMPIT Q
25 S LRX=$G(^LRO(68,LRAA,0)) I '($L(LRX)) D DUMPIT Q
26 S LRLD=$S($L($P(LRX,"^",19)):$P(LRX,"^",19),1:"CP")
27 S LRACC=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,.2)) I '($L(LRACC)) D DUMPIT Q
28 S LRX=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)) I '($L(LRX)) D DUMPIT Q
29 S LRIDT=$P(LRX,U,5),LRFILE=$S(LRFNUM=2:"DPT(",1:"")
30 I LRFILE="" S:$D(^DIC(LRFNUM,0,"GL"))=1 LRFILE=^("GL")
31 S LRREC=$S($D(^LR(LRREC,0))#2:$P(^LR(LRREC,0),"^",3),1:"")
32 S LRFILE=LRREC_";"_$S($E(LRFILE,1)=U:$E(LRFILE,2,99),1:LRFILE)
33 S LRX=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTS,0)) I '($L(LRX)) D DUMPIT Q
34 I $E($P(LRX,U,6))="*" D DUMPIT Q
35 S LRUG=$P(LRX,U,2)
36 F LRCC=0:0 S LRCC=+$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTS,1,LRCC)) Q:LRCC<1 D LRCAPC
37 Q
38LRCAPC ;
39 S LRX=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTS,1,LRCC,0)) I '$L(LRX) D DUMPIT Q
40 ; CHECK COUNTED FOR WORKLOAD IN FILE #68
41 Q:$P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTS,1,LRCC,0),U,3)
42 S LRCDT=$P(LRX,U,6),LRCTM=$P(LRCDT,".",2),LRCDT=$P(LRCDT,".") S:LRCTM="" LRCTM="08"
43 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)
44 S:LRIN="" LRIN=$P($G(^XMB(1,1,"XUS")),U,17)
45 S:'LRCNT LRCNT=1 S (LRUW,LRCWT)=0
46 I $D(^LAM(LRCC,0))#2 S LRX=^(0),LRUW=$P(LRX,"^",3),LRCWT=$P(LRX,"^",11)
47 I (LRCC="")!(LRCDT="")!(LRIN="") D DUMPIT Q
48 D ^LRCAPV3
49 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
50 Q
51DUMPIT ;
52 Q ;Comment this line to set trap
53 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
54 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:"")
55 S LRESTR=LRESTR_" CDT= "_$S($D(LRCDT):LRCDT,1:"")_" CT= "_$S($D(LRCTM):LRCTM,1:"")
56 S ^TMP("LR WL ERRORS",LRERR,$H)=LRESTR
57 Q
58CLEAN ;
59 L -^LRO(68,"AA")
60 I $D(ZTQUEUED) S ZTREQ="@"
61 K LRAA,LRACC,LRAD,LRAN,LRCC,LRCDT,LRCNT,LRCTM,LRFILE,LRFNUM,LRIDT,LRIN,LRLSS,LRMA,LROAD,LROL,LRRREC,LRRRL,LRTEC
62 K LRTS,LRUG,LRX,LRZCNT,LRERR,LRQC,LRII,LRNT,LRCWT,LRREC,LRUW,X,LRESTR,LRWA,%,LRLD,LROAD1,LROAD2,LRRRL1,LRRRL2,LRRRL3,LRRRL4
63 Q
64TRAP ;
65 S $P(^LAB(69.9,1,"NITE"),U)="ERROR"_$P(^("NITE"),U) D @^%ZOSF("ERRTN")
66 Q
Note: See TracBrowser for help on using the repository browser.