source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRCAPBB.m@ 1604

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

initial load of WorldVistAEHR

File size: 4.2 KB
Line 
1LRCAPBB ;SLC/AM/DALISC/FHS/CYM - STORE WORKLOAD FROM 65,65.5 INTO ^LRO(64.1 ;4/3/96
2 ;;5.2;LAB SERVICE;**72,201**;Sep 27, 1994
3EN ;
4 Q:'$P($G(^LAB(69.9,1,0)),U,14)
5 S:'$D(^LAB(69.9,1,"NITE")) ^("NITE")=""
6 L +^LRD(65,"AA"):1 I '$T G FIN
7 L +^LRE("AA"):1 I '$T G FIN
8 S $P(^LAB(69.9,1,"NITE"),"^",4)=$$NOW^XLFDT
9 ;S X="TRAP^LRCAPBB",@^%ZOSF("TRAP")
10INVENT ;
11 D INIT G:'$O(^LRD(65,"AA",0)) DONOR D FT
12 I LRERR K ^LRD(65,"AA") D DUMP S ^TMP("LR WL ERRORS",LRX)="BASIC LRD(65 DATA MISSING" G DONOR
13 F S LRREC=$O(^LRD(65,"AA",LRREC)) Q:LRREC="" S LRTS="" D
14 .S LRFILE=LRREC_";LRD(65," F S LRTS=$O(^LRD(65,"AA",LRREC,LRTS)) Q:LRTS="" S LRDTTM="" F S LRDTTM=$O(^LRD(65,"AA",LRREC,LRTS,LRDTTM)) Q:LRDTTM="" S LRACC=^(LRDTTM) D K ^LRD(65,"AA",LRREC,LRTS,LRDTTM)
15 ..S LRCC=0 F S LRCC=$O(^LRD(65,LRREC,99,LRTS,1,LRDTTM,1,LRCC)) Q:LRCC<1 D
16 ...; LRRRL3 is the log in person, LRRRL4 is location type
17 ...;S $P(^LAB(69.9,1,"NITE"),U,4)=LRREC_"99 "_LRTS_","_LRDTTM_","_LRCC
18 ...S LRX=$G(^LRD(65,LRREC,99,LRTS,1,LRDTTM,0)),LRRRL3=$P(LRX,U,2),LRIN=$P(LRX,U,3),(LRAA,LRMA)=+$P(LRX,U,4),LRLSS=+$P(LRX,U,5) S:'LRLSS LRLSS=LRMA D CHK
19 ...S LRX=$G(^LRD(65,LRREC,99,LRTS,1,LRDTTM,1,LRCC,0)),LRCNT=+$P(LRX,U,2)
20 ...S:'LRCNT LRCNT=1
21 ...S LRCTM=$P(LRDTTM,".",2),LRCDT=$P(LRDTTM,"."),(LRUW,LRCWT)=1
22 ...I $D(^LAM(LRCC,0))#2 S LRX=^(0),LRUW=$P(LRX,"^",3),LRCWT=$P(LRX,"^",11)
23 ...I (LRIN="")!(LRCC="")!(LRCDT="")!(LRCTM="")!(LRTS="") D DUMP Q
24 ...W:'$D(ZTQUEUED) !,"WKLD CODE "_LRCC
25 ...D ^LRCAPV3
26 ...S $P(^LRD(65,LRREC,99,LRTS,1,LRDTTM,1,LRCC,0),"^",3)=1
27 ..Q
28DONOR ;
29 I '$O(^LRE("AA",0)) G FIN
30 S LRERR=0,LRREC="" D FT2
31 I LRERR K ^LRE("AA") D DUMP S ^TMP("LR WL ERRORS",LRX)="BASIC LRE( DATA MISSING" G FIN
32 F S LRREC=$O(^LRE("AA",LRREC)) Q:LRREC="" S LRI="",LRFILE=LRREC_";LRE(" F S LRI=$O(^LRE("AA",LRREC,LRI)) Q:LRI="" S LRTS="" F S LRTS=$O(^LRE("AA",LRREC,LRI,LRTS)) Q:LRTS="" D
33 .S LRDTTM="" F LRDTTM=$O(^LRE("AA",LRREC,LRI,LRTS,LRDTTM)) Q:LRDTTM="" S LRACC=^(LRDTTM) D
34 ..W:'$D(ZTQUEUED) !?5,"DONOR "_LRDTTM
35 ..S LRCC=0 F S LRCC=$O(^LRE(LRREC,5,LRI,99,LRTS,1,LRDTTM,1,LRCC)) Q:LRCC<1 D K ^LRE("AA",LRREC,LRI,LRTS,LRDTTM)
36 ...; LRRRL3 is the log in person, LRRRL4 is location type
37 ...;S $P(^LAB(69.9,1,"NITE"),U,4)=LRREC_"5 "_LRI_"99 "_LRTS_","_LRDTTM_","_LRCC
38 ...S LRX=$G(^LRE(LRREC,5,LRI,99,LRTS,1,LRDTTM,0)),LRRRL3=$P(LRX,U,2)
39 ...S LRX=$G(^LRE(LRREC,5,LRI,99,LRTS,1,LRDTTM,1,LRCC,0)),LRCNT=+$P(LRX,U,2)
40 ...S:'LRCNT LRCNT=1
41 ...S LRCTM=$P(LRDTTM,".",2),LRCDT=$P(LRDTTM,"."),(LRWU,LRCWT)=1
42 ...I $D(^LAM(LRCC,0))#2 S LRX=^(0),LRUW=$P(LRX,"^",3),LRCWT=$P(LRX,"^",11)
43 ...I (LRIN="")!(LRCC="")!(LRCDT="")!(LRCTM="")!(LRTS="") D DUMP Q
44 ...D ^LRCAPV3
45 ...S $P(^LRE(LRREC,5,LRI,99,LRTS,1,LRDTTM,1,LRCC,0),"^",3)=1
46 ..Q
47FIN S $P(^LAB(69.9,1,"NITE"),"^",4)="" L -^LRD(65,"AA") L -^LRE("AA")
48 I $D(ZTQUEUED) S ZTREQ="@"
49 D CLEAN
50 Q
51FT ;
52 S LRX=$G(^LAB(69.9,1,8.1,+$G(^LAB(69.9,1,10)),0)),LRIN=$P(LRX,U),(LRAA,LRMA)=+$P(LRX,U,2),LRLSS=+$P(LRX,U,3) S:'LRLSS LRLSS=LRMA D CHK
53 Q
54FT2 ;
55 S LRX=$G(^LAB(69.9,1,8.1,+$G(^LAB(69.9,1,10)),0)),LRIN=$P(LRX,U),(LRAA,LRMA)=+$P(LRX,U,4),LRLSS=+$P(LRX,U,5) S:'LRLSS LRLSS=LRMA D CHK
56 Q
57CHK S LRERR=$S('LRIN:1,'LRMA:1,1:0) Q:LRERR
58 S:'$D(^LRO(68,LRMA,0))#2 LRERR=1 Q:LRERR S LRX=^(0) I '$P(LRX,U,16) S LRERR=1 Q
59 S:'LRLSS LRLSS=LRMA S LRWA=LRLSS
60 S LRLD=$S($L($P(LRX,U,19)):$P(LRX,U,19),1:"CP")
61 Q
62DUMP ;
63 S LRX=$S($D(^TMP("LR WL ERRORS",0))#2:$P(^(0),U,3),1:0)+1,^TMP("LR WL ERRORS",0)=U_U_LRX
64 S LRESTR="BLOOD BANK RECORD= "_$S($D(LRREC):LRREC,1:"")_" TS= "_$S($D(LRTS):LRTS,1:"")_" CC= "_$S($D(LRCC):LRCC,1:"")_" IN= "_$S($D(LRIN):LRIN,1:"")
65 S LRESTR=LRESTR_" CDT= "_$S($D(LRCDT):LRCDT,1:"")_" CT= "_$S($D(LRCTM):LRCTM,1:"")
66 S ^TMP("LR WL ERRORS",LRX,$H)=LRESTR
67 Q
68CLEAN ;
69 Q:$D(TEST) K LRACC,LRAD,LRCC,LRDTTM,LRCDT,LRCNT,LRCTM,LRFILE,LRIDT,LRIN,LRLSS,LRMA
70 K LROAD,LROL,LRRREC,LRRRL,LRTEC,LRTS,LRUG,LRX,LRZCNT,LRERR,LRQC,LRII
71 K LRNT,LRCWT,LRREC,LRUW,X,LRESTR,LRWA,%,LRLD,LROAD1,LROAD2,LRRRL1
72 K LRRRL2,LRRRL3,LRRRL4,LRI,LRFIRST,LRFNUM,LREND
73 Q
74INIT ;
75 S (LRREC,LRTS,LRACC,LROAD,LROAD1,LROAD2,LRRRL,LRRRL1,LRRRL2,LRRRL3,LROL,LRII,LRIDT,LRTEC,LRFNUM,LRERR)="",LRRRL4="Z",LRUG=50 ; These variables are needed by LRCAPV3
76 Q
77TRAP ;
78 S LREND=1 S:$D(^LAB(69.9,1,"NITE")) $P(^LAB(69.9,1,"NITE"),U,4)="ERROR"_$P(^("NITE"),"^",4) D @^%ZOSF("ERRTN")
79 Q
Note: See TracBrowser for help on using the repository browser.